From e830088656cd43e9361b0dcd94bc1c06de5e2be7 Mon Sep 17 00:00:00 2001 From: smaeyama Date: Fri, 25 Mar 2022 12:09:04 +0900 Subject: [PATCH 1/6] pre-implementation of rotating flux tube model --- run/Makefile | 100 +- run/diff.txt | 1529 +++++++++++++++++++++++++ run/gkvp_namelist | 18 +- run/shoot | 14 +- run/sub.q | 171 ++- src/gkvp_advnc.f90 | 44 +- src/gkvp_geom.f90 | 2624 +++++++++++++++++++++++++++++++++++++++++++ src/gkvp_header.f90 | 15 +- src/gkvp_main.f90 | 2 +- src/gkvp_set.f90 | 1428 +---------------------- 10 files changed, 4376 insertions(+), 1569 deletions(-) create mode 100644 run/diff.txt create mode 100644 src/gkvp_geom.f90 diff --git a/run/Makefile b/run/Makefile index e28c901..d078f99 100644 --- a/run/Makefile +++ b/run/Makefile @@ -1,42 +1,39 @@ -### Fujitsu Fortran Compiler ### -FC = mpifrtpx -FFLAGS = -Kfast,parallel # Optimization -FFLAGS += -X9 # Fortran95 -FFLAGS += -Koptmsg=2 -Nlst=t # Optimization report -FFLAGS += -fw # Suppress message -FFLAGS += -Kopenmp #-Nfjomplib # OpenMP -FFLAGS += -mcmodel=large # Static memory larger than 2GB -#FFLAGS += -Haefosux -NRtrap #-O0 # Debug -OPTRPT = 'lst' -#FFLAGS += -Nfjprof # Fujitsu profiler fapp -FFLAGS += -Ksimd_nouse_multiple_structures # Specific option for compiler tcs1.2.26 to avoid slowing down GKV -FFLAGS += -Knosch_pre_ra # Specific option for compiler tcs1.2.26 to avoid slowing down GKV -INC = -LIB = +###FC = mpinfort +FC = mpinfort -compiler /opt/nec/ve/nfort/3.0.4/bin/nfort +FFLAGS = -report-all -O3 -fpp $(EXTRA) #-mparallel +FFLAGS += -fdiag-vector=2 -fdiag-inline=2 -fdiag-parallel=2 +FFLAGS_OMP1= #-fopenmp #around FFT +FFLAGS_OMP2= #-fopenmp #others +FFLAGS_OMP3= #-fopenmp #bndry&advnc +ifneq ("x$(FFLAGS_OMP1)_$(FFLAGS_OMP2)_$(FFLAGS_OMP3)_","x___") + FFLAGS_LOMP= -fopenmp +endif PROG = 'gkvp.exe' -SRC = ../src/ +SDIR = src +SRC = ../$(SDIR)/ MYL = ../lib/ MATH = gkvp_math_portable -FFT = gkvp_fft_fftw -### Usage of FFTW (module load fftw-tune) -ifeq ($(FFT),gkvp_fft_fftw) - #INC += -I$(FFTW_DIR)/include - #LIB += -L$(FFTW_DIR)/lib -lfftw3 -lm - LIB += -lfftw3 -lm +FFT = gkvp_f0.56_fft_fftw_tune2r_0813 +### Usage of FFTW +ifeq ($(FFT),gkvp_f0.56_fft_fftw_tune2r_0813) + NLC_HOME=/opt/nec/ve/nlc/2.1.0 + INC = -I$(NLC_HOME)/include + LIB = -L$(NLC_HOME)/lib -laslfftw3 -lasl_sequential -ftrace + #LIB = -L$(NLC_HOME)/lib -laslfftw3 -lasl_openmp endif FILEIO=gkvp_fileio_fortran #FILEIO=gkvp_fileio_netcdf -### Usage of NetCDF (module load netcdf-fortran netcdf-c phdf5) -### NetCDF does not work on the FLOW supercomputer for now, Jan 17 2021 +### Usage of NetCDF (module load netcdf-parallelIO-fortran-sx) ifeq ($(FILEIO),gkvp_fileio_netcdf) - #INC += -I$(NETCDF_FORTRAN_DIR)/include -I$(NETCDF_DIR)/include -I$(PHDF5_DIR)/include - #LIB += -L$(NETCDF_FORTRAN_DIR)/lib -L$(NETCDF_DIR)/lib -L$(PHDF5_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 + FC = mpinfort + #INC += -I$(NFORT_INCLUDE_PATH) + #LIB += -L$(NFORT_LIBRARY_PATH) -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 LIB += -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 endif @@ -50,17 +47,18 @@ gkvp: $(SRC)gkvp_header.f90\ $(SRC)gkvp_tips.f90\ $(SRC)gkvp_vmecbzx.f90\ $(SRC)gkvp_igs.f90\ - $(SRC)gkvp_bndry.f90\ - $(SRC)gkvp_colli.f90\ + $(SRC)gkvp_f0.56_bndry_tune_nec1.f90\ + $(SRC)gkvp_f0.56_colli_tune_nifs.f90\ $(SRC)$(FFT).f90\ $(SRC)gkvp_fld.f90\ $(SRC)gkvp_colliimp.f90\ $(SRC)gkvp_freq.f90\ - $(SRC)gkvp_zfilter.f90\ - $(SRC)gkvp_exb.f90\ + $(SRC)gkvp_f0.56_zfilter_tune_nec1.f90\ + $(SRC)gkvp_f0.56_exb_tune2r_0813.f90\ $(SRC)gkvp_trans.f90\ - $(SRC)gkvp_advnc.f90\ $(SRC)gkvp_shearflow.f90\ + $(SRC)gkvp_geom.f90\ + $(SRC)gkvp_advnc.f90\ $(SRC)gkvp_dtc.f90\ $(SRC)gkvp_out.f90\ $(SRC)gkvp_set.f90\ @@ -75,23 +73,24 @@ gkvp: $(SRC)gkvp_header.f90\ $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 - $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) + $(FC) $(FFLAGS) $(FFLAGS_OMP3) -c $(SRC)gkvp_f0.56_bndry_tune_nec1.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP2) -c $(SRC)gkvp_f0.56_colli_tune_nifs.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP1) -c $(SRC)$(FFT).f90 $(INC) $(FC) $(FFLAGS) -c $(SRC)gkvp_fld.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP2) -c $(SRC)gkvp_f0.56_zfilter_tune_nec1.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP1) -c $(SRC)gkvp_f0.56_exb_tune2r_0813.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP1) -c $(SRC)gkvp_trans.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_shearflow.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP3) -c $(SRC)gkvp_advnc.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_dtc.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_out.f90 + $(FC) $(FFLAGS) $(FFLAGS_OMP2) -c $(SRC)gkvp_out.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_set.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_main.f90 - $(FC) $(FFLAGS) \ + $(FC) $(FFLAGS) $(FFLAGS_LOMP) \ gkvp_header.o\ gkvp_mpienv.o\ $(MATH).o\ @@ -101,30 +100,31 @@ gkvp: $(SRC)gkvp_header.f90\ gkvp_tips.o\ gkvp_vmecbzx.o\ gkvp_igs.o\ - gkvp_bndry.o\ - gkvp_colli.o\ + gkvp_f0.56_bndry_tune_nec1.o\ + gkvp_f0.56_colli_tune_nifs.o\ $(FFT).o\ gkvp_fld.o\ gkvp_colliimp.o\ gkvp_freq.o\ - gkvp_zfilter.o\ - gkvp_exb.o\ + gkvp_f0.56_zfilter_tune_nec1.o\ + gkvp_f0.56_exb_tune2r_0813.o\ gkvp_trans.o\ - gkvp_advnc.o\ gkvp_shearflow.o\ + gkvp_geom.o\ + gkvp_advnc.o\ gkvp_dtc.o\ gkvp_out.o\ gkvp_set.o\ gkvp_main.o\ -o $(PROG) $(LIB) - cp *.o *.mod *.$(OPTRPT) ../src/ - rm -f *.o *.mod *.$(OPTRPT) + \cp *.L *.o *.mod ../$(SDIR)/ + \rm -f *.L *.o *.mod clean: - rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ - ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* + rm -f ../$(SDIR)/*.LL ../$(SDIR)/*.L ../$(SDIR)/*.o ../$(SDIR)/*.mod ../$(SDIR)/*.lst + rm -f ./*.exe ./sub.q.* ./gkvp_namelist.* clear: - rm -f ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* + rm -f ./*.o ./*.mod ./*.L ./*.LL diff --git a/run/diff.txt b/run/diff.txt new file mode 100644 index 0000000..4b28b39 --- /dev/null +++ b/run/diff.txt @@ -0,0 +1,1529 @@ +diff gkvp/src/gkvp_advnc.f90 src/gkvp_advnc.f90 +19c19 +< use GKV_colliimp, only: colliimp_calc_colli_full, colliimp_set_param +--- +> use GKV_colliimp, only: colliimp_calc_colli_full +25d24 +< use GKV_geom, only: geom_increment_time +97,107d95 +< !%%% For shearflow rotating flux tube model %%% +< if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "rotating") then +< if (istep == 2 .or. istep == 4) then +< call geom_increment_time(0.5_DP * dt) +< if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then +< call colliimp_set_param +< end if +< end if +< end if +< !%%% +< +494c482 +< real(kind=DP) :: cefv, cs1, rotating_cf4, rotating_up5 +--- +> real(kind=DP) :: cefv, cs1 +509,517d496 +< !%%% For shearflow rotating flux tube model %%% +< if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "rotating") then +< rotating_cf4 = - gamma_e / (s_hat_g * 12._DP * (zz(0)-zz(-1))) +< rotating_up5 = - gamma_e / (s_hat_g * 60._DP * (zz(0)-zz(-1))) +< else +< rotating_cf4 = 0._DP +< rotating_up5 = 0._DP +< end if +< !%%% +527,530c506 +< !%%% For shearflow rotating flux tube model %%% +< !!!- vl(iv) * cefz(iz) * ( & +< - (vl(iv) * cefz(iz) + rotating_cf4) * ( & +< !%%% +--- +> - vl(iv) * cefz(iz) * ( & +567,573d542 +< !%%% For shearflow rotating flux tube model %%% +< - rotating_cf4 * ( & +< - ff(mx,my,iz+2,iv) & +< + 8._DP * ff(mx,my,iz+1,iv) & +< - 8._DP * ff(mx,my,iz-1,iv) & +< + ff(mx,my,iz-2,iv) ) & +< !%%% +602,608d570 +< !%%% For shearflow rotating flux tube model %%% +< - rotating_cf4 * ( & +< - ff(mx,my,iz+2,iv) & +< + 8._DP * ff(mx,my,iz+1,iv) & +< - 8._DP * ff(mx,my,iz-1,iv) & +< + ff(mx,my,iz-2,iv) ) & +< !%%% +Only in gkvp/src/: gkvp_geom.f90 +diff gkvp/src/gkvp_header.f90 src/gkvp_header.f90 +41,43c41,43 +< integer, parameter :: nxw = 20, nyw = 20 +< integer, parameter :: nx = 4, global_ny = 1 ! 2/3 de-aliasing rule +< integer, parameter :: global_nz = 12, global_nv = 24, global_nm = 7 +--- +> integer, parameter :: nxw = 2, nyw = 20 +> integer, parameter :: nx = 0, global_ny = 12 ! 2/3 de-aliasing rule +> integer, parameter :: global_nz = 48, global_nv = 24, global_nm = 15 +52c52 +< integer, parameter :: nprocw = 1, nprocz = 2, nprocv = 4, nprocm = 2, nprocs = 1 +--- +> integer, parameter :: nprocw = 2, nprocz = 4, nprocv = 2, nprocm = 2, nprocs = 1 +172c172 +< real(kind=DP) :: mach, uprime, gamma_e, kxmin_g, kymin_g, tlim_exb, s_hat_g +--- +> real(kind=DP) :: mach, uprime, gamma_e, kxmin_g, kymin_g, tlim_exb +203,207d202 +< +< !character(15) :: flag_shearflow = "remap" ! Wavevector remap method +< ! ! with nearest grid approximation +< ! ! (Discontinuous in time) +< character(15) :: flag_shearflow = "rotating" ! Rotating flux tube model +diff gkvp/src/gkvp_main.f90 src/gkvp_main.f90 +139c139 +< if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "remap") then +--- +> if (gamma_e /= 0._DP) then +diff gkvp/src/gkvp_set.f90 src/gkvp_set.f90 +24c24,25 +< use GKV_math, only: math_random +--- +> use GKV_math, only: math_j0, math_j1, math_j2, math_g0, math_random +> use GKV_intgrl, only: intgrl_fsrf, intgrl_v0_moment_ms +28a30,35 +> ! for vmec equilibrium +> ! use GKV_vmecin, only: vmecin_fileopen, vmecin_coeff, vmecin_read +> ! for vmec equilibrium w/ Booz_xform by M. Nakata & M. Nunami (Aug. 2016) +> use GKV_vmecbzx, only: vmecbzx_boozx_read, vmecbzx_boozx_coeff +> ! for tokamak(eqdsk) equilibrium +> use GKV_igs, only: igs_read, igs_coeff +35,37d41 +< use GKV_geom, only : geom_read_nml, geom_init_kxkyzvm, & +< geom_init_metric, geom_set_operators, & +< geom_reset_time +44a49 +> +391a397,443 +> real(kind=DP) :: s_hat +> +> real(kind=DP) :: eps_r +> +> real(kind=DP) :: rdeps00, eps_hor, lprd, mprd, lmmq, malpha +> real(kind=DP) :: eps_mor, eps_por, lprdm1, lprdp1, lmmqm1, lmmqp1 +> real(kind=DP) :: eps_rnew, rdeps1_0, rdeps1_10, rdeps2_10, rdeps3_10 +> +> ! for s-alpha model with Shafranov shift +> real(kind=DP) :: p_total, dp_totaldx, beta_total, alpha_MHD +> +> ! for circular MHD +> real(kind=DP), dimension(1:3,1:3) :: gg +> real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy +> +> +> !! for vmec equilibrium +> ! real(kind=DP) :: rho2R_0, q_input, theta +> ! real(kind=DP) :: r_0 +> ! real(kind=DP) :: gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & +> ! gupss, guptt, gupzz, gupst, gupsz, guptz, & +> ! babs, Bs , Bth , Bzt , dBds, dBdt, dBdz, & +> ! dBdt_mir, vmec_rootg, rootgft, rootgbz +> real(kind=DP) :: theta +> +> +> real(kind=DP) :: lx, ly, lz, kxmin, kymin, dz, mmax, dm, del_c +> real(kind=DP) :: lz_l, z0, z0_l +> integer :: n_tht, m_j +> +> real(kind=DP) :: gg0 +> +> real(kind=DP) :: bb, kmo +> real(kind=DP) :: cfsrf_l +> +> integer :: global_iv, global_im +> integer :: mx, my, iz, iv, im, is, is1, is2, ierr_mpi +> +> +> complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf +> complex(kind=DP), dimension(:,:,:), allocatable :: nw +> real(kind=DP), dimension(:,:,:), allocatable :: ww +> +> ! real(kind=DP) :: rad_a, r_minor, eps_b, rho_unit, r_a +> ! real(kind=DP) :: R0_unit, r_edge, b0b00, alpha_fix +> +> real(kind=DP), dimension(0:ns-1) :: eta +393,394c445 +< real(kind=DP) :: lx, ly, eps_r +< integer :: is1, is2 +--- +> real(kind=DP) :: r_major +395a447,489 +> real(kind=DP) :: s_input, s_0 ! radial label of fluxtube center +> integer :: mc_type ! 0:Axisym., 1:Boozer, 2:Hamada +> integer :: q_type ! 0:use q and s_hat value in confp, 1:calclated by IGS +> integer :: isw, nss, ntheta, nzeta +> real(kind=DP) :: phi_ax ! axisymetric toroidal angle +> +> integer, parameter :: num_omtr = 13 +> real(kind=DP) :: metric_l(1:num_omtr,-nz:nz-1), metric_g(1:num_omtr,-global_nz:global_nz-1) +> +> +> +> +> namelist /physp/ R0_Ln, & ! R0/Lns +> R0_Lt, & ! R0/Lts +> nu, & ! factor for collision freq. in LB model +> Anum, & ! mass number +> Znum, & ! charge number +> fcs, & ! charge-density fraction +> sgn, & ! signs of charge +> tau, & ! T-ratio Ts/T0, T0=reference ion temp. of ranks=1 +> dns1, & ! initial perturbation amplitude +> tau_ad, & ! Ti/Te for ITG-ae, Te/Ti for ETG-ai +> lambda_i, & ! (Debye/rho_tp)^2 +> beta, & ! mu0*ni*Ti/B^2 +> ibprime, & ! flag for finite beta-prime effect on kvd +> vmax, & ! maximum v_para in unit of v_ts +> nx0 ! mode number for the initial perturbation +> +> namelist /rotat/ mach, uprime, gamma_e +> +> namelist /nperi/ n_tht, kymin, m_j, del_c +> namelist /confp/ eps_r, eps_rnew, & +> q_0, s_hat, & +> lprd, mprd, eps_hor, eps_mor, eps_por, & +> rdeps00, rdeps1_0, rdeps1_10, & +> rdeps2_10, rdeps3_10, malpha +> ! namelist /vmecp/ q_0, rad_a, & +> ! R0_unit, r_edge, & +> ! b0b00, alpha_fix +> namelist /vmecp/ s_input, nss, ntheta, nzeta +> +> namelist /igsp/ s_input, mc_type, q_type, nss, ntheta +> +403,404c497,1787 +< ! --- read GKV namelist relating to configurations --- +< call geom_read_nml +--- +> tau(:) = 1.0_DP +> nu(:) = 0.002_DP +> R0_Ln(:) = 2.5_DP +> R0_Lt(:) = 7.5_DP +> +> +> read(inml,nml=physp) +> +> +> do is = 0, ns-1 +> if( R0_Ln(is) /= 0._DP ) then +> eta(is) = R0_Lt(is) / R0_Ln(is) +> else +> eta(is) = 1.d+20 +> end if +> end do +> +> +> write( olog, * ) " # Physical parameters" +> write( olog, * ) "" +> write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) +> write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) +> write( olog, * ) " # eta = ", eta(:) +> write( olog, * ) " # nu = ", nu(:) +> write( olog, * ) " # A-number = ", Anum(:) +> write( olog, * ) " # Z-number = ", Znum(:) +> write( olog, * ) " # fcs = ", fcs(:) +> write( olog, * ) " # sgn = ", sgn(:) +> write( olog, * ) " # tau = ", tau(:) +> write( olog, * ) " # dns1 = ", dns1(:) +> write( olog, * ) " # tau_ad = ", tau_ad +> write( olog, * ) " # lambda_i^2 = ", lambda_i +> write( olog, * ) " # beta_i = ", beta +> write( olog, * ) " # ibprime = ", ibprime +> write( olog, * ) " # nx0 = ", nx0 +> write( olog, * ) "" +> +> +> mach = 0._DP +> uprime = 0._DP +> gamma_e = 0._DP +> +> read(inml,nml=rotat) +> +> write( olog, * ) " # Mean rotation parameters" +> write( olog, * ) "" +> write( olog, * ) " # Mach number = ", mach +> write( olog, * ) " # uptime = ", uprime +> write( olog, * ) " # gamma_ExB = ", gamma_e +> write( olog, * ) "" +> +> +> n_tht = 1 +> +> read(inml,nml=nperi) +> +> +> if( trim(equib_type) == "slab") then +> +> read(inml,nml=confp) +> +> lprdm1 = 0._DP +> lprdp1 = 0._DP +> +> lmmq = 0._DP +> lmmqm1 = 0._DP +> lmmqp1 = 0._DP +> +> q_0 = 1._DP ! For now, fixed q_0=1. Changing q_0 can extend parallel z-box size. +> s_hat = 0._DP ! only shear less slab +> eps_r = 1._DP +> +> eps_hor = 0._DP +> lprd = 0._DP +> mprd = 0._DP +> malpha = 0._DP +> +> rdeps00 = 0._DP +> eps_mor = 0._DP +> eps_por = 0._DP +> +> write( olog, * ) " # Configuration parameters" +> write( olog, * ) "" +> write( olog, * ) " # q_0 = ", q_0 +> write( olog, * ) " # s_hat = ", s_hat +> write( olog, * ) " # eps_r = ", eps_r +> write( olog, * ) "" +> +> write( olog, * ) " # eps_hor = ", eps_hor +> write( olog, * ) " # lprd = ", lprd +> write( olog, * ) " # mprd = ", mprd +> write( olog, * ) " # malpha = ", malpha +> write( olog, * ) " # rdeps00 = ", rdeps00 +> +> write( olog, * ) " # eps_mor = ", eps_mor +> write( olog, * ) " # lprdm1 = ", lprdm1 +> write( olog, * ) " # eps_por = ", eps_por +> write( olog, * ) " # lprdp1 = ", lprdp1 +> write( olog, * ) "" +> +> else if( trim(equib_type) == "analytic" .OR. & +> trim(equib_type) == "s-alpha" .OR. & +> trim(equib_type) == "s-alpha-shift" .OR. & +> trim(equib_type) == "circ-MHD" ) then +> +> +> read(inml,nml=confp) +> +> +> lprdm1 = lprd - 1.0_DP +> lprdp1 = lprd + 1.0_DP +> +> lmmq = lprd - mprd * q_0 +> lmmqm1 = lprdm1 - mprd * q_0 +> lmmqp1 = lprdp1 - mprd * q_0 +> +> +> write( olog, * ) " # Configuration parameters" +> write( olog, * ) "" +> write( olog, * ) " # q_0 = ", q_0 +> write( olog, * ) " # s_hat = ", s_hat +> write( olog, * ) " # eps_r = ", eps_r +> write( olog, * ) "" +> +> write( olog, * ) " # eps_hor = ", eps_hor +> write( olog, * ) " # lprd = ", lprd +> write( olog, * ) " # mprd = ", mprd +> write( olog, * ) " # malpha = ", malpha +> write( olog, * ) " # rdeps00 = ", rdeps00 +> +> write( olog, * ) " # eps_mor = ", eps_mor +> write( olog, * ) " # lprdm1 = ", lprdm1 +> write( olog, * ) " # eps_por = ", eps_por +> write( olog, * ) " # lprdp1 = ", lprdp1 +> write( olog, * ) "" +> +> +> +> ! else if( trim(equib_type) == "vmec" ) then +> ! +> ! +> !! --- Paramters at rho=0.65 (shot#088343 at t = 1.833 [s]) +> !! +> !! Ln_unit =-4.230701_DP ! Ln [m] +> !! Lt_unit = 0.3135611_DP ! Lt [m] +> !! R0_unit = 3.599858_DP ! R0 [m] +> !! r_edge = 0.6362872D0 ! r_edge [m] +> !! b0b00 = 2.88846853946973647d0/2.940307D0 ! b00mode/B0 +> !! alpha_fix = 0.314159253589793d0 ! pi/10 +> !! +> ! +> ! read(inml,nml=vmecp) +> ! +> ! eps_b = r_edge / R0_unit ! --- a / R ! by nunami (2010.04.21) +> ! +> ! rho2R_0 = eps_b / rad_a ! --- rho / R_0 +> ! rho_unit = rho2R_0 * R0_unit ! --- rho +> ! r_a = rad_a * rho2R_0 ! --- rad_a / R_0 +> ! +> ! eps_r = 0.1115200537d0 +> ! +> ! call vmecin_fileopen +> ! +> ! +> ! call vmecin_read +> ! +> ! +> ! q_input = q_0 +> ! theta = 0._DP +> ! +> ! call vmecin_coeff( rad_a, R0_unit, rho2R_0, q_input, theta, & +> ! alpha_fix, r_0, r_minor, s_hat, & +> ! gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & +> ! gupss, guptt, gupzz, gupst, gupsz, guptz, & +> ! babs, Bs, Bth, Bzt, dBds, dBdt, dBdz, & +> ! dBdt_mir, vmec_rootg, rootgft, rootgbz ) +> ! +> ! +> ! write( olog, * ) " # Configuration parameters" +> ! write( olog, * ) "" +> ! write( olog, * ) " # q_0 = ", q_0 +> ! write( olog, * ) " # s_hat = ", s_hat +> ! write( olog, * ) "" +> ! write( olog, * ) " # eps_r = ", eps_r +> ! write( olog, * ) "" +> +> +> else if( trim(equib_type) == "vmec" ) then +> +> +> read(inml,nml=confp) +> +> read(inml,nml=vmecp) +> +> call vmecbzx_boozx_read( nss, ntheta, nzeta ) +> +> isw = 0 +> iz = 0 +> call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, 0._DP, lz_l, & ! input +> s_0, q_0, s_hat, eps_r, phi_ax, & ! output +> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & +> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & +> gg(2,3), gg(3,3) ) +> +> +> +> write( olog, * ) " # Configuration parameters" +> write( olog, * ) "" +> write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) +> write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) +> write( olog, * ) " # eta = ", eta(:) +> write( olog, * ) " # q_0 = ", q_0 +> write( olog, * ) " # s_hat = ", s_hat +> write( olog, * ) " # eps_r = ", eps_r +> write( olog, * ) " # s_input, s_0 = ", s_input, s_0 +> write( olog, * ) " # nss, ntheta, nzeta = ", nss, ntheta, nzeta +> +> +> else if( trim(equib_type) == "eqdsk" ) then +> +> +> read(inml,nml=confp) +> +> read(inml,nml=igsp) +> +> call igs_read( mc_type, nss, ntheta ) +> +> if ( q_type == 1 ) then +> isw = 0 +> iz = 0 +> call igs_coeff( isw, mc_type, nss, ntheta, s_input, 0._DP, lz_l, & ! input +> s_0, q_0, s_hat, eps_r, theta, & ! output +> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & +> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & +> gg(2,3), gg(3,3) ) +> end if +> +> +> +> write( olog, * ) " # Configuration parameters" +> write( olog, * ) "" +> write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) +> write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) +> write( olog, * ) " # eta = ", eta(:) +> write( olog, * ) " # q_0 = ", q_0 +> write( olog, * ) " # s_hat = ", s_hat +> write( olog, * ) " # eps_r = ", eps_r +> write( olog, * ) " # s_input, s_0 = ", s_input, s_0 +> write( olog, * ) " # nss, ntheta = ", nss, ntheta +> +> else +> +> write( olog, * ) " # wrong choice of the equilibrium " +> call flush(olog) +> call MPI_Finalize(ierr_mpi) +> stop +> +> end if +> +> +> ! --- coordinate settings --- +> +> if (abs(s_hat) < 1.d-10) then ! When s_hat == ZERO +> m_j = 0 +> kxmin = kymin +> else if (m_j == 0) then +> kxmin = kymin +> else +> kxmin = abs(2._DP * pi * s_hat * kymin / real(m_j, kind=DP)) +> end if +> lx = pi / kxmin +> ly = pi / kymin +> ! kymin=pi/ly=pi/[r_minor*pi/(q0*n_alp)]=q0*n_alp/r_minor +> +> lz = real( n_tht, kind=DP ) * pi ! total z-length +> lz_l = lz / real( nprocz, kind=DP ) ! local z-length +> +> do mx = -nx, nx +> kx(mx) = kxmin * real( mx, kind=DP ) +> end do +> +> ky(:) = 0._DP +> do my = ist_y_g, iend_y_g +> ky(my-ist_y_g) = kymin * real( my, kind=DP ) +> end do +> +> kxmin_g = kxmin +> kymin_g = kymin +> +> z0 = - lz ! global lower boundary +> z0_l = 2._DP * lz_l * real( rankz, kind=DP ) + z0 +> ! local lower boundary +> +> dz = lz_l / real( nz, kind=DP ) +> +> do iz = -nz, nz-1 +> zz(iz) = dz * real( iz + nz, kind=DP ) + z0_l +> end do +> +> +> dv = 2._DP * vmax / real( 2 * nv * nprocv -1, kind=DP ) +> +> do iv = 1, 2*nv +> global_iv = 2 * nv * rankv + iv +> vl(iv) = dv * ( real( global_iv - nv * nprocv - 1, kind=DP ) + 0.5_DP ) +> end do +> ! --- debug +> ! write( olog, * ) " *** iv, vl " +> ! do iv = 1, 2*nv +> ! global_iv = 2 * nv * rankv + iv +> ! write( olog, * ) iv, global_iv, vl(iv) +> ! end do +> ! write( olog, * ) "" +> +> mmax = vmax +> dm = mmax / real( nprocm * ( nm+1 ) - 1, kind=DP ) +> ! --- equal spacing in vperp +> +> do im = 0, nm +> global_im = ( nm+1 ) * rankm + im +> mu(im) = 0.5_DP * ( dm * real( global_im, kind=DP ) )**2 +> end do +> +> +> write( olog, * ) " # Numerical parameters" +> write( olog, * ) "" +> write( olog, * ) " # n_tht = ", n_tht +> write( olog, * ) " # lx, ly, lz = ", lx, ly, lz +> write( olog, * ) " # lz, z0 = ", lz, z0 +> write( olog, * ) " # lz_l, z0_l = ", lz_l, z0_l +> write( olog, * ) " # kxmin, kymin = ", kxmin, kymin +> write( olog, * ) " # kxmax, kymax = ", kxmin*nx, kymin*global_ny +> write( olog, * ) " # kperp_max = ", sqrt((kxmin*nx)**2+(kymin*global_ny)**2) +> write( olog, * ) " # m_j, del_c = ", m_j, del_c +> write( olog, * ) " # dz = ", dz +> write( olog, * ) " # dv, vmax = ", dv, vmax +> write( olog, * ) " # dm, mmax = ", dm, mmax +> write( olog, * ) "" +> +> if (gamma_e == 0._DP) then +> tlim_exb = 999999.d0 +> else +> tlim_exb = (kxmin*(nx-nx0))/(kymin*global_ny*abs(gamma_e)) +> end if +> write( olog, * ) " # ExB limit time tlim_exb = ", tlim_exb +> write( olog, * ) " # for (mx=nx0,my=global_ny) initial perturbation: " +> write( olog, * ) " # tlim_exb = kxmin*(nx-nx0)/(kymax*|gamma_e|)" +> write( olog, * ) "" +> +> +> ! --- coordinate settings --- +> +> +> ! --- operator settings --- +> +> +> do iz = -nz, nz-1 +> +> !!! for slab model +> if ( trim(equib_type) == "slab") then +> +> q_bar = q_0 +> r_major = 1._DP ! in the R0 unit +> theta = zz(iz) +> +> omg(iz) = 1._DP +> rootg(iz) = q_0*r_major +> dpara(iz) = dz * q_0 * r_major +> +> do im = 0, nm +> vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) +> mir(iz,im) = 0._DP +> do iv = 1, 2*nv +> vdx(iz,iv,im) = 0._DP +> vdy(iz,iv,im) = 0._DP +> vsy(iz,iv,im) = & +> - sgn(ranks) * tau(ranks) / Znum(ranks) & +> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> + omg(iz)*mu(im) - 1.5_DP ) ) +> end do +> end do ! im loop ends +> +> ksq(:,:,iz) = 0._DP +> do my = ist_y, iend_y +> do mx = -nx, nx +> ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 +> end do +> end do +> +> baxfactor = 1._DP +> +> !- for OUTPUT hst/*.mtr.* - +> domgdz = 0._DP +> domgdy = 0._DP +> domgdx = 0._DP +> gg(1,1) = 1._DP +> gg(1,2) = 0._DP +> gg(1,3) = 0._DP +> gg(2,1) = gg(1,2) +> gg(2,2) = 1._DP +> gg(2,3) = 0._DP +> gg(3,1) = gg(1,3) +> gg(3,2) = gg(2,3) +> gg(3,3) = 1._DP +> metric_l( 1,iz) = zz(iz) ! [ 1] +> metric_l( 2,iz) = theta ! [ 2] +> metric_l( 3,iz) = omg(iz) ! [ 3] +> metric_l( 4,iz) = domgdx ! [ 4] +> metric_l( 5,iz) = domgdy ! [ 5] +> metric_l( 6,iz) = domgdz ! [ 6] +> metric_l( 7,iz) = gg(1,1) ! [ 7] +> metric_l( 8,iz) = gg(1,2) ! [ 8] +> metric_l( 9,iz) = gg(1,3) ! [ 9] +> metric_l(10,iz) = gg(2,2) ! [10] +> metric_l(11,iz) = gg(2,3) ! [11] +> metric_l(12,iz) = gg(3,3) ! [12] +> metric_l(13,iz) = rootg(iz)! [13] +> !------------------------- +> +> +> !!! for the concentric and large-aspect-ratio model !!! +> else if( trim(equib_type) == "analytic" ) then +> +> q_bar = q_0 +> r_major = 1._DP ! in the R0 unit +> +> theta = zz(iz) +> +> omg(iz) = 1._DP & +> - eps_r * ( cos( zz(iz) ) & +> + eps_hor * cos( lmmq * zz(iz) - malpha ) & +> + eps_mor * cos( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * cos( lmmqp1 * zz(iz) - malpha ) ) +> +> rootg(iz) = q_0*r_major/omg(iz) +> dpara(iz) = dz * q_0 * r_major +> +> ! --- debug +> ! write( olog, * ) " *** z, omg " +> ! do iz = -nz, nz-1 +> ! write( olog, * ) zz(iz), omg(iz) +> ! end do +> ! write( olog, * ) +> +> do im = 0, nm +> +> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +> mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & +> * ( sin(zz(iz)) & +> + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & +> + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) +> +> do iv = 1, 2*nv +> !do my = ist_y, iend_y +> ! do mx = -nx, nx +> ! kvd and kvs are revised November 2011 +> ! into general species forms. +> !!!!kvd(mx,my,iz,iv,im)= & +> !!!! - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & +> !!!! * ( ky(my) * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & +> !!!! + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +> !!!! + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +> !!!! + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & +> !!!! + ( kx(mx) + s_hat * zz(iz) * ky(my) ) & +> !!!! * ( sin( zz(iz) ) & +> !!!! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +> !!!! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> !!!! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +> !!!! ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> !!!!kvs(mx,my,iz,iv,im) = & +> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & +> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) +> +> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% +> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% +> vdx(iz,iv,im)= & +> - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & +> * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & +> + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +> + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +> + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & +> + ( 1._DP + s_hat * zz(iz) * 0._DP ) & +> * ( sin( zz(iz) ) & +> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +> ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vdy(iz,iv,im)= & +> - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & +> * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & +> + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +> + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +> + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & +> + ( 0._DP + s_hat * zz(iz) * 1._DP ) & +> * ( sin( zz(iz) ) & +> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +> ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vsy(iz,iv,im) = & +> - sgn(ranks) * tau(ranks) / Znum(ranks) & +> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> + omg(iz)*mu(im) - 1.5_DP ) ) +> +> ! end do +> !end do +> end do +> +> end do ! im loop ends +> +> +> ksq(:,:,iz) = 0._DP +> do my = ist_y, iend_y +> do mx = -nx, nx +> ksq(mx,my,iz) = ( kx(mx) + s_hat * zz(iz) * ky(my) )**2 + ky(my)**2 +> end do +> end do +> +> baxfactor = 1._DP +> +> !- for OUTPUT hst/*.mtr.* - !%%% under benchmark %%% +> domgdz = eps_r * ( sin(zz(iz)) & +> + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & +> + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) +> domgdy = - eps_rnew / r_major * ( & +> - ( sin( zz(iz) ) & +> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) & +> ) - (-1._DP/eps_r) * domgdz ) +> domgdx = eps_rnew / r_major * ( & +> - ( & +> rdeps00 & +> + rdeps1_0 * cos( zz(iz) ) & +> + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +> + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +> + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) & +> + s_hat * zz(iz) * ( sin( zz(iz) ) & +> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +> ) - (-s_hat*zz(iz)/eps_r) * domgdz ) +> gg(1,1) = 1._DP +> gg(1,2) = s_hat*zz(iz) +> gg(1,3) = 0._DP +> gg(2,1) = gg(1,2) +> gg(2,2) = 1._DP + (s_hat*zz(iz))**2 +> gg(2,3) = 1._DP/(r_major*eps_r) +> gg(3,1) = gg(1,3) +> gg(3,2) = gg(2,3) +> gg(3,3) = 1._DP/((r_major*eps_r)**2) +> metric_l( 1,iz) = zz(iz) ! [ 1] +> metric_l( 2,iz) = theta ! [ 2] +> metric_l( 3,iz) = omg(iz) ! [ 3] +> metric_l( 4,iz) = domgdx ! [ 4] +> metric_l( 5,iz) = domgdy ! [ 5] +> metric_l( 6,iz) = domgdz ! [ 6] +> metric_l( 7,iz) = gg(1,1) ! [ 7] +> metric_l( 8,iz) = gg(1,2) ! [ 8] +> metric_l( 9,iz) = gg(1,3) ! [ 9] +> metric_l(10,iz) = gg(2,2) ! [10] +> metric_l(11,iz) = gg(2,3) ! [11] +> metric_l(12,iz) = gg(3,3) ! [12] +> metric_l(13,iz) = rootg(iz)! [13] +> !------------------------- +> +> !!! for s-alpha !!! <--- the current version is the same as "analytic" +> else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then +> +> q_bar = q_0 +> r_major = 1._DP ! in the R0 unit +> +> if (trim(equib_type) == "s-alpha") then +> !--- s-alpha model without Shafranov shift - +> alpha_MHD = 0._DP +> else if (trim(equib_type) == "s-alpha-shift") then +> !--- s-alpha model with Shafranov shift ---- +> p_total = 0._DP +> dp_totaldx = 0._DP +> beta_total = 0._DP +> do is = 0, ns-1 +> p_total = p_total + fcs(is) * tau(is) / Znum(is) +> dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) +> beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) +> end do +> alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total +> end if +> +> theta = zz(iz) +> +> omg(iz) = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion +> !omg(iz) = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark +> +> rootg(iz) = q_0*r_major/omg(iz) +> dpara(iz) = dz* q_0 * r_major +> +> domgdz = eps_r * sin( theta ) +> !domgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark +> domgdx = -cos( theta ) / r_major +> domgdy = 0._DP +> +> +> gg(1,1) = 1._DP +> gg(1,2) = s_hat*zz(iz) - alpha_MHD*sin(zz(iz)) ! with Shafranov shift +> gg(1,3) = 0._DP +> gg(2,1) = gg(1,2) +> gg(2,2) = 1._DP + (s_hat*zz(iz) - alpha_MHD*sin(zz(iz)))**2 ! with Shafranov shift +> gg(2,3) = 1._DP/(r_major*eps_r) +> gg(3,1) = gg(1,3) +> gg(3,2) = gg(2,3) +> gg(3,3) = 1._DP/((r_major*eps_r)**2) +> +> kkx = -r_major * (q_0/q_bar) & +> * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz +> kky = r_major * (q_bar/q_0) & +> * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) +> +> do im = 0, nm +> +> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +> +> mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) +> +> do iv = 1, 2*nv +> !do my = ist_y, iend_y +> ! do mx = -nx, nx +> +> !!!!kvd(mx,my,iz,iv,im) = & +> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & +> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & +> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> !!!!kvs(mx,my,iz,iv,im) = & +> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & +> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) & +> !!!! * (q_bar/q_0) +> +> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% +> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% +> vdx(iz,iv,im) = & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & +> * kkx & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vdy(iz,iv,im) = & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & +> * kky & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vsy(iz,iv,im) = & +> - sgn(ranks) * tau(ranks) / Znum(ranks) & +> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> + omg(iz)*mu(im) - 1.5_DP ) ) & +> * (q_bar/q_0) +> +> ! end do +> !end do +> end do +> +> end do ! im loop ends +> +> +> ksq(:,:,iz) = 0._DP +> do my = ist_y, iend_y +> do mx = -nx, nx +> ksq(mx,my,iz) = ( kx(mx) + ( s_hat * zz(iz) - alpha_MHD*sin(zz(iz)) ) & +> * ky(my) )**2 + ky(my)**2 ! with Shafranov shift +> end do +> end do +> +> baxfactor = 1._DP +> +> !- for OUTPUT hst/*.mtr.* - +> metric_l( 1,iz) = zz(iz) ! [ 1] +> metric_l( 2,iz) = theta ! [ 2] +> metric_l( 3,iz) = omg(iz) ! [ 3] +> metric_l( 4,iz) = domgdx ! [ 4] +> metric_l( 5,iz) = domgdy ! [ 5] +> metric_l( 6,iz) = domgdz ! [ 6] +> metric_l( 7,iz) = gg(1,1) ! [ 7] +> metric_l( 8,iz) = gg(1,2) ! [ 8] +> metric_l( 9,iz) = gg(1,3) ! [ 9] +> metric_l(10,iz) = gg(2,2) ! [10] +> metric_l(11,iz) = gg(2,3) ! [11] +> metric_l(12,iz) = gg(3,3) ! [12] +> metric_l(13,iz) = rootg(iz)! [13] +> !------------------------- +> +> +> !!! for circular MHD equilibrium !!! +> else if( trim(equib_type) == "circ-MHD" ) then +> +> q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 +> r_major = 1._DP ! in the R0 unit +> +> theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & +> * tan(zz(iz)/2._DP) ) +> +> omg(iz) = sqrt( q_bar**2 + eps_r**2 ) & +> / ( 1._DP + eps_r*cos( theta ) ) / q_bar +> +> rootg(iz) = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 +> dpara(iz) = dz * omg(iz) * rootg(iz) +> +> +> domgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & +> / ( 1._DP + eps_r * cos( theta ) )**2 & +> / ( 1._DP - eps_r * cos( zz(iz)) ) / q_0 +> +> domgdx = -( cos(theta) & +> - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & +> *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & +> - eps_r*sin(theta)**2/(1._DP-eps_r**2) & +> ) / ((1._DP + eps_r*cos(theta))**2) & +> * sqrt(q_bar**2+eps_r**2) / q_bar / r_major +> +> domgdy = 0._DP +> +> gg(1,1) = (q_0/q_bar)**2 +> gg(1,2) = ( s_hat*zz(iz)*q_0/q_bar - eps_r*sin(zz(iz))/(1._DP-eps_r**2) )*q_0/q_bar +> gg(1,3) = - sin(zz(iz))/(1._DP-eps_r**2)/r_major*q_0/q_bar +> gg(2,1) = gg(1,2) +> gg(2,2) = (s_hat*zz(iz)*q_0/q_bar)**2 - 2._DP*q_0/q_bar*s_hat*zz(iz)*eps_r*sin(zz(iz))/(1._DP-eps_r**2) & +> + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & +> + (eps_r*sin(zz(iz)))**2/(1._DP-eps_r**2)**2 +> gg(2,3) = ( -s_hat*zz(iz)*q_0/q_bar*sin(zz(iz))/(1._DP-eps_r**2) & +> + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & +> + eps_r*(sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & +> ) / r_major +> gg(3,1) = gg(1,3) +> gg(3,2) = gg(2,3) +> gg(3,3) = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & +> + (sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & +> ) / (r_major**2) +> +> kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) +> kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) +> +> do im = 0, nm +> +> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +> +> mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) +> +> do iv = 1, 2*nv +> !do my = ist_y, iend_y +> ! do mx = -nx, nx +> +> !!!!kvd(mx,my,iz,iv,im)= & +> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & +> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> !!!!kvs(mx,my,iz,iv,im) = & +> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & +> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) +> +> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% +> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% +> vdx(iz,iv,im)= & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> * kkx & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vdy(iz,iv,im)= & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> * kky & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vsy(iz,iv,im) = & +> - sgn(ranks) * tau(ranks) / Znum(ranks) & +> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> + omg(iz)*mu(im) - 1.5_DP ) ) +> +> +> ! end do +> !end do +> end do +> +> end do ! im loop ends +> +> +> ksq(:,:,iz) = 0._DP +> do my = ist_y, iend_y +> do mx = -nx, nx +> ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & +> + 2._DP*kx(mx)*ky(my)*gg(1,2) & +> + (ky(my)**2)*gg(2,2) +> end do +> end do +> +> baxfactor = 1._DP +> +> !- for OUTPUT hst/*.mtr.* - +> metric_l( 1,iz) = zz(iz) ! [ 1] +> metric_l( 2,iz) = theta ! [ 2] +> metric_l( 3,iz) = omg(iz) ! [ 3] +> metric_l( 4,iz) = domgdx ! [ 4] +> metric_l( 5,iz) = domgdy ! [ 5] +> metric_l( 6,iz) = domgdz ! [ 6] +> metric_l( 7,iz) = gg(1,1) ! [ 7] +> metric_l( 8,iz) = gg(1,2) ! [ 8] +> metric_l( 9,iz) = gg(1,3) ! [ 9] +> metric_l(10,iz) = gg(2,2) ! [10] +> metric_l(11,iz) = gg(2,3) ! [11] +> metric_l(12,iz) = gg(3,3) ! [12] +> metric_l(13,iz) = rootg(iz)! [13] +> !------------------------- +> +> !!!! for VMEC equilibrium !!! +> ! else if( trim(equib_type) == "vmec" ) then +> ! +> ! q_bar = q_0 +> ! theta = zz(iz) +> ! +> ! call vmecin_coeff( rad_a, R0_unit, rho2R_0, q_input, theta, & +> ! alpha_fix, r_0, r_minor, s_hat, & +> ! gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & +> ! gupss, guptt, gupzz, gupst, gupsz, guptz, & +> ! babs, Bs, Bth, Bzt, dBds, dBdt, dBdz, & +> ! dBdt_mir, vmec_rootg, rootgft, rootgbz ) +> ! +> ! omg(iz) = babs +> ! +> ! rootg(iz) = vmec_rootg * R0_unit * R0_unit * R0_unit +> ! dpara(iz) = dz * babs * rootgft * b0b00 +> ! +> ! +> ! +> ! do im = 0, nm +> ! +> ! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +> ! mir(iz,im) = mu(im) * dBdt_mir / babs / rootgft / b0b00 +> ! +> ! do iv = 1, 2*nv +> ! do my = ist_y, iend_y +> ! do mx = -nx, nx +> ! +> ! kvd(mx,my,iz,iv,im) = & +> ! - (( vl(iv)**2 + omg(iz)*mu(im) ) / rootgbz /babs/babs/babs ) & +> ! * ((r_0/q_0) * ky(my) & +> ! * ( ( (Bs/r_a) + Bzt * (q_0/r_0) * s_hat * zz(iz) ) * dBdt & +> ! +( (Bs/r_a) * q_0 - Bth * (q_0/r_0) * s_hat * zz(iz) ) * dBdz & +> ! -( Bth + Bzt * q_0 ) * dBds / r_a ) & +> ! + kx(mx) * ( Bzt * dBdt - Bth * dBdz )) & +> ! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> ! ! --- k*v_d term +> ! +> ! kvs(mx,my,iz,iv,im) = & +> ! - sgn(ranks) * ky(my) & +> ! * ((r_0/q_0) * (Bth + Bzt * q_0) / rootgbz / babs / babs) & +> ! * ( R0_Ln(ranks) & +> ! + R0_Lt(ranks) * (0.5_DP*vl(iv)**2 + omg(iz)*mu(im) - 1.5_DP) ) & +> ! * tau(ranks) / Znum(ranks) +> ! ! --- k*v_* term +> ! end do +> ! end do +> ! end do +> ! +> ! end do ! im loop ends +> ! +> ! +> ! do my = ist_y, iend_y +> ! do mx = -nx, nx +> ! ksq(mx,my,iz) = (r_a * kx(mx))**2 * gupss & +> ! + ky(my)**2 * ( (r_0/q_0)**2 & +> ! * ( gupzz + guptt * q_0 **2 - guptz * 2._DP * q_0 ) & +> ! + 2._DP * s_hat * (r_0/q_0) * zz(iz) * r_a * ( gupst * q_0 - gupsz ) & +> ! + r_a * r_a * gupss * (s_hat**2) * (zz(iz)**2) ) & +> ! + (r_a * kx(mx)) * ky(my) * 2._DP * ( (r_0/q_0) & +> ! * ( gupst * q_0 - gupsz ) + r_a * gupss * s_hat * zz(iz) ) +> ! ! --- squere of k_perp +> ! end do +> ! end do +> ! +> ! baxfactor = b0b00 ! --- For the use in caldlt +> ! +> +> ! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) +> else if( trim(equib_type) == "vmec" ) then +> +> q_bar = q_0 +> isw = 1 +> r_major = 1._DP ! in the R0 unit +> +> call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz(iz), lz_l, & ! input +> s_0, q_0, s_hat, eps_r, phi_ax, & ! output +> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & +> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & +> gg(2,3), gg(3,3) ) +> +> dpara(iz) = dz * omg(iz) * rootg(iz) +> +> kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) +> kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) +> +> do im = 0, nm +> +> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +> +> mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) +> +> do iv = 1, 2*nv +> !do my = ist_y, iend_y +> ! do mx = -nx, nx +> +> !!!!kvd(mx,my,iz,iv,im) = & +> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & +> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & +> !!!! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term +> !!!! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks))*ky(my) ) & +> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> !!!!kvs(mx,my,iz,iv,im) = & +> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & +> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) +> +> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% +> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% +> vdx(iz,iv,im) = & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> * kkx & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> +> vdy(iz,iv,im) = & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> * kky & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & +> - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term +> * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vsy(iz,iv,im) = & +> - sgn(ranks) * tau(ranks) / Znum(ranks) & +> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> + omg(iz)*mu(im) - 1.5_DP ) ) +> +> +> ! end do +> !end do +> end do +> +> end do ! im loop ends +> +> +> ksq(:,:,iz) = 0._DP +> do my = ist_y, iend_y +> do mx = -nx, nx +> ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & +> + 2._DP*kx(mx)*ky(my)*gg(1,2) & +> + (ky(my)**2)*gg(2,2) +> end do +> end do +> +> baxfactor = 1._DP +> +> !- for OUTPUT hst/*.mtr.* - +> metric_l( 1,iz) = zz(iz) ! [ 1] +> metric_l( 2,iz) = phi_ax ! [ 2] Axisymetric toroidal angle +> metric_l( 3,iz) = omg(iz) ! [ 3] +> metric_l( 4,iz) = domgdx ! [ 4] +> metric_l( 5,iz) = domgdy ! [ 5] +> metric_l( 6,iz) = domgdz ! [ 6] +> metric_l( 7,iz) = gg(1,1) ! [ 7] +> metric_l( 8,iz) = gg(1,2) ! [ 8] +> metric_l( 9,iz) = gg(1,3) ! [ 9] +> metric_l(10,iz) = gg(2,2) ! [10] +> metric_l(11,iz) = gg(2,3) ! [11] +> metric_l(12,iz) = gg(3,3) ! [12] +> metric_l(13,iz) = rootg(iz)! [13] +> !------------------------- +> +> +> else if( trim(equib_type) == "eqdsk" ) then +> +> q_bar = q_0 +> isw = 1 +> r_major = 1._DP ! in the R0 unit +> +> call igs_coeff( isw, mc_type, nss, ntheta, s_input, zz(iz), lz_l, & ! input +> s_0, q_0, s_hat, eps_r, theta, & ! output +> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & +> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & +> gg(2,3), gg(3,3) ) +> +> dpara(iz) = dz * omg(iz) * rootg(iz) +> +> kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) +> kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) +> +> do im = 0, nm +> +> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +> +> mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) +> +> do iv = 1, 2*nv +> !do my = ist_y, iend_y +> ! do mx = -nx, nx +> +> !!!!kvd(mx,my,iz,iv,im) = & +> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & +> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & +> !!!! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term +> !!!! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks))*ky(my) ) & +> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> !!!!kvs(mx,my,iz,iv,im) = & +> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & +> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) +> +> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% +> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% +> vdx(iz,iv,im) = & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> * kkx & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vdy(iz,iv,im) = & +> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +> * kky & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & +> - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term +> * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & +> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +> +> vsy(iz,iv,im) = & +> - sgn(ranks) * tau(ranks) / Znum(ranks) & +> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +> + omg(iz)*mu(im) - 1.5_DP ) ) +> +> +> ! end do +> !end do +> end do +> +> end do ! im loop ends +> +> +> ksq(:,:,iz) = 0._DP +> do my = ist_y, iend_y +> do mx = -nx, nx +> ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & +> + 2._DP*kx(mx)*ky(my)*gg(1,2) & +> + (ky(my)**2)*gg(2,2) +> end do +> end do +> +> baxfactor = 1._DP +> +> !- for OUTPUT hst/*.mtr.* - +> metric_l( 1,iz) = zz(iz) ! [ 1] +> metric_l( 2,iz) = theta ! [ 2] +> metric_l( 3,iz) = omg(iz) ! [ 3] +> metric_l( 4,iz) = domgdx ! [ 4] +> metric_l( 5,iz) = domgdy ! [ 5] +> metric_l( 6,iz) = domgdz ! [ 6] +> metric_l( 7,iz) = gg(1,1) ! [ 7] +> metric_l( 8,iz) = gg(1,2) ! [ 8] +> metric_l( 9,iz) = gg(1,3) ! [ 9] +> metric_l(10,iz) = gg(2,2) ! [10] +> metric_l(11,iz) = gg(2,3) ! [11] +> metric_l(12,iz) = gg(3,3) ! [12] +> metric_l(13,iz) = rootg(iz)! [13] +> !------------------------- +> +> +> else +> +> write( olog, * ) " # wrong choice of the equilibrium " +> call flush(olog) +> call MPI_Finalize(ierr_mpi) +> stop +> +> end if +> +> +> do im = 0, nm +> do my = ist_y, iend_y +> do mx = -nx, nx +> kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & +> * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) +> call math_j0( kmo, j0(mx,my,iz,im) ) +> call math_j1( kmo, j1(mx,my,iz,im) ) +> call math_j2( kmo, j2(mx,my,iz,im) ) +> end do +> end do +> end do +> +> +> do my = ist_y, iend_y +> do mx = -nx, nx +> bb = ksq(mx,my,iz) / omg(iz)**2 & +> * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) +> call math_g0( bb, g0(mx,my,iz) ) +> end do +> end do +> +> +> !!!! debug (Jan 2012) +> ! write( olog, fmt="(1p,10e15.7)" ) & +> ! zz(iz), omg(iz), mir(iz,0), dpara(iz), jcob(iz), & +> ! ksq(1,2,iz), kvs(1,2,iz,1,0), kvd(1,2,iz,1,0), j0(1,2,iz,0), g0(1,2,iz) +> !!!! debug (Jan 2012) +> +> +> end do ! iz loop ends +> +> !- OUTPUT ascii data hst/*.mtr.* - +> call MPI_gather(metric_l(1,-nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & +> metric_g(1,-global_nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & +> 0, zsp_comm_world, ierr_mpi) +> if ( rankg == 0 ) then +> do iz = -global_nz, global_nz-1 +> write( omtr, fmt="(f15.8,SP,256E24.14e3)") metric_g(:,iz) +> end do +> call flush(omtr) +> end if +> !--------------------------------- +> +> ! --- operator settings --- +> +> +> cfsrf = 0._DP +> cfsrf_l = 0._DP +> do iz = -nz, nz-1 +> ! cfsrf_l = cfsrf_l + 1._DP / omg(iz) +> cfsrf_l = cfsrf_l + rootg(iz) +> ! normalization coefficient for +> ! the surface average +> end do +> +> call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & +> MPI_SUM, zsp_comm_world, ierr_mpi ) +> +> +> ! --- debug +> ! write( olog, * ) " *** z, omg " +> ! do iz = -nz, nz-1 +> ! write( olog, * ) zz(iz), omg(iz) +> ! end do +> ! write( olog, * ) +> +> +> if ( vel_rank == 0 ) then +> do iz = -nz, nz-1 +> !dvp(iz) = vp(iz,1) +> dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) +> end do +> end if +> +> call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & +> vel_comm_world, ierr_mpi ) +> +> +> do my = ist_y_g, iend_y_g +> ck(my-ist_y_g) = exp( ui * 2._DP * pi * del_c & +> * real( n_tht * my, kind=DP ) ) +> dj(my-ist_y_g) = - m_j * n_tht * my +> ! del_c = q_0*n_alp-int(q_0*n_alp) +> ! m_j = 2*n_alp*q_d +> end do +> +> +> do im = 0, nm +> do iv = 1, 2*nv +> do iz = -nz, nz-1 +> fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & +> / sqrt( twopi**3 ) +> end do +> end do +> end do +> +> allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) +> +> ! --- GK polarization factor for efield calculation +> fct_poisson(:,:,:) = 0._DP +> fct_e_energy(:,:,:) = 0._DP +> +> ww(:,:,:) = 0._DP +> do iz = -nz, nz-1 +> do my = ist_y, iend_y +> do mx = -nx, nx +> +> if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode +> +> fct_poisson(mx,my,iz) = 0._DP +> fct_e_energy(mx,my,iz) = 0._DP +> +> else +> +> ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) +> do is = 0, ns-1 +> bb = ksq(mx,my,iz) / omg(iz)**2 & +> * tau(is)*Anum(is)/(Znum(is)**2) +> call math_g0( bb, gg0 ) +> ww(mx,my,iz) = ww(mx,my,iz) & +> + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) +> end do +> fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) +> fct_e_energy(mx,my,iz) = ww(mx,my,iz) +> +> end if +> +> end do +> end do +> end do +> +> +> ! --- ZF-factor for adiabatic model +> if ( ns == 1 ) then +> +> ww(:,:,:) = 0._DP +> do iz = -nz, nz-1 +> my = 0 +> do mx = -nx, nx +> ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & +> / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) +> end do +> end do +> +> call intgrl_fsrf ( ww, fctgt ) +> +> if ( rankw == 0 ) then +> fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) +> ! g0(0,0,iz) has no z dependence +> endif +> +> endif +> +> deallocate( ww ) +> +> allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) +> allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) +> wf(:,:,:,:,:) = ( 0._DP, 0._DP ) +> nw(:,:,:) = ( 0._DP, 0._DP ) +> +> ! --- GK polarization factor for mfield calculation +> fct_ampere(:,:,:) = 0._DP +> fct_m_energy(:,:,:) = 0._DP +> +> if ( beta .ne. 0._DP ) then +> +> do im = 0, nm +> do iv = 1, 2*nv +> do iz = -nz, nz-1 +> do my = ist_y, iend_y +> do mx = -nx, nx +> wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & +> * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) +> end do +> end do +> end do +> end do +> end do +> +> call intgrl_v0_moment_ms ( wf, nw ) +> +> do iz = -nz, nz-1 +> do my = ist_y, iend_y +> do mx = -nx, nx +> fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) +> fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta +> end do +> end do +> end do +> +> if ( rankw == 0 ) then +> do iz = -nz, nz-1 +> fct_ampere(0,0,iz) = 0._DP +> fct_m_energy(0,0,iz) = 0._DP +> end do +> end if +> +> end if +> +> deallocate( wf ) +> deallocate( nw ) +406,407d1788 +< ! --- coordinate settings (time-indep.) --- +< call geom_init_kxkyzvm(lx, ly, eps_r) +411a1793,1799 +> !if (trim(time_advnc) == "imp_colli" .or. trim(time_advnc) == "auto_init") then +> if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then +> call colliimp_set_param +> end if +> !!! call colliimp_set_param +> call dtc_init( lx, ly, vmax ) +> +441,451d1828 +< ! --- coordinate settings (explicitly time-dependent metrics) --- +< call geom_init_metric +< +< ! --- operator settings (time-dependent through metrics) --- +< call geom_set_operators +< if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then +< call colliimp_set_param +< end if +< +< ! --- initial estimate of time steps --- +< call dtc_init( lx, ly, vmax ) +594,602d1970 +< +< !%%% For shearflow rotating flux tube model %%% +< if (gamma_e /= 0._DP .and. trim(flag_shearflow) =="rotating") then +< call geom_reset_time(time) +< if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then +< call colliimp_set_param +< end if +< end if +< !%%% diff --git a/run/gkvp_namelist b/run/gkvp_namelist index 76abf64..b28deb4 100644 --- a/run/gkvp_namelist +++ b/run/gkvp_namelist @@ -1,5 +1,5 @@ &cmemo memo="GKV-plus f0.61 developed for pre-exa-scale computing", &end - &calct calc_type="lin_freq", + &calct calc_type="linear", z_bound="outflow", z_filt="off", z_calc="cf4", @@ -7,7 +7,7 @@ init_random=.false., num_triad_diag=0, &end &triad mxt = 0, myt = 0/ - &equib equib_type = "analytic", &end + &equib equib_type = "s-alpha", &end &run_n inum=%%%, ch_res = .false., &end &files f_log="%%DIR%%/log/gkvp.", @@ -25,8 +25,8 @@ adapt_dt = .true., courant_num = 0.5d0, time_advnc = "auto_init", &end - &physp R0_Ln = 2.22d0, - R0_Lt = 6.92d0, + &physp R0_Ln = 2.2d0, + R0_Lt = 10.d0, nu = 1.d0, Anum = 1.d0, Znum = 1.d0, @@ -39,17 +39,17 @@ beta = 0.d0, ibprime = 0, vmax = 4.5d0, - nx0 = 10000, &end + nx0 = 0, &end &rotat mach = 0.d0, uprime = 0.d0, - gamma_e = 0.d0, &end - &nperi n_tht = 3, - kymin = 0.05d0, + gamma_e = 0.2d0, &end + &nperi n_tht = 1, + kymin = 0.5d0, m_j = 1, del_c = 0.d0, &end &confp eps_r = 0.18d0, eps_rnew = 1.d0, - q_0 = 1.4d0, + q_0 = 1.39d0, s_hat = 0.8d0, lprd = 0.d0, mprd = 0.d0, diff --git a/run/shoot b/run/shoot index ce833cd..507eeea 100755 --- a/run/shoot +++ b/run/shoot @@ -14,10 +14,10 @@ if [ $# -lt 2 ]; then fi #### Environment setting -DIR=/data/group1/z43460z/gkvp/f0.61/ITGae-lin +DIR=/data/lng/maeyama/gkvp/f0.62/dev_shearflow/dev19_gamma0.2_remap LDM=gkvp.exe NL=gkvp_namelist -SC=pjsub +SC=qsub JS=sub.q ### For VMEC, set VMCDIR including metric_boozer.bin.dat #VMCDIR=./input_vmec/vmec_sample_nss501ntheta1024nzeta0 @@ -76,15 +76,19 @@ do #${SC} ${fln_JS} if [ -z "$j" -a $i -eq $1 ]; then echo "*** submit first step job ${fln_JS} ***" - ${SC} --step --sparam "sn=$i" ${fln_JS} | tee shoottempfile - j=`awk '{sub("_.*",""); print $6}' shoottempfile` + ${SC} ${fln_JS} | tee shoottempfile + j=`awk '{sub(".nqsv*",""); print $2}' shoottempfile` rm shoottempfile else echo "*** submit sequential step job ${fln_JS} ***" - ${SC} --step --sparam "jid=$j,sd=ec!=0:all" ${fln_JS} + ${SC} --after $j ${fln_JS} | tee shoottempfile + j=`awk '{sub(".nqsv*",""); print $2}' shoottempfile` + rm shoottempfile fi + sleep 1 i=$(( $i + 1 )) done + diff --git a/run/sub.q b/run/sub.q index ab115f4..d9cc221 100755 --- a/run/sub.q +++ b/run/sub.q @@ -1,66 +1,65 @@ -#!/bin/sh +#!/bin/bash ### NOTE ### -### Flow supercomputer Type I sub-system, PRIMEHPC FX1000 (Nagoya Univ, 2020) +### Plasma simulator, NEC SX-Aurora TSUBASA A412-8 (NIFS, 2020) ### -### - Computation nodes(total 2304 nodes) -### CPU: A64FX (2.0GHz, 12coresx4CMG=48cores, 512bit SIMD) x1 per node -### Peak performance: DP 3.379 TFLOPS per node (Boost: 3.3792 TFLOPS) -### Cache L1: 64 KiB, 4 way -### Cache L1 Bandwidth: 230+ GB/s(load), 115+ GB/s (store) -### Cache L2: 8 MiB, 16 way per CMG(NUMA), 4CMG per node -### Cache L2 Bandwidth: 3.6+ TB/s per node -### 115+ GB/s(load), 57+ GB/s(store) per core -### Memory: HBM2 32 GiB -### Memory Bandwidth: 1024 GB/s per node +### - Computation nodes (total 4320 VE (Vector engine)) +### VE model: Type 10AE (8cores) +### Peak performance: DP 2.433 TFLOPS per VE +### Memory: HBM2 48 GiB +### Memory Bandwidth: ? GB/s per node ### -### Therefore, a recommended GKV parallelization may be -### (MPI Processes)x(12 OpenMP Threads) -### =(12 cores per CMG)x(4 CMG)x(Node numbers) -### 1 MPI process should be assigined to 1 CMG. +### (For now, flat MPI is recommended.) ### ### - Interconnect -### Tofu Interconnect D (28 Gbps x 2 lane x 10 port) -### [Performance] 8B Put latency: 0.49-0.54 usec -### 1MiB Put throughput: 6.35 GB/s +### Infiniband HDR200 x2, 1000BASE-Tx1, BMC ### -### - Job class (May 2020) -### fx-debug : 1 - 36 nodes, 1 hour, 50 run/300 submit -### fx-small : 1 - 24 nodes, 168 hour, 100 run/300 submit -### fx-middle : 12 - 96 nodes, 72 hour, 50 run/300 submit -### fx-large : 96 - 192 nodes, 72 hour, 25 run/300 submit -### fx-xlarge : 96 - 768 nodes, 24 hour, 5 run/300 submit +### - Job class : Computation server (SX-Aurora) +### small : 1 - 16 VE, 15 min., 1 run/ 1 submit +### small24VE : 1 - 4 VE, 24 hour, 8 run/16 submit +### small24VH : 8 - 32 VE, 24 hour, 8 run/16 submit +### medium : 40 - 768 VE, 10 hour, 4 run/ 8 submit +### large : 1920 - 2160 VE, 10 hour, 1 run/ 4 submit +### large1h : 1920 - 2160 VE, 1 hour, 1 run/ 2 submit +### debug : 8 - 16 VE, 30 min., 1 run/ 1 submit, interactive +### +### - Job class : Data analysis server (LX) +### gpu-b : 1 - 4 Servers, 10 hour, 1 run/2 submit +### gpu-i : 1 - 2 Servers, 10 hour, 1 run/1 submit, interactive ### ### - Commands -### (Submit a batch job : "pjsub sub.q") Use shoot script for GKV. -### Check job status : "pjstat" or "pjstat -E" for step jobs -### Delete job : "pjdel JOBID" -### Show budget info : "charge" -### Show disk usage : "lfs quota -u (YOUR ACCOUNT ID) /home" -### : "lfs quota -u (YOUR ACCOUNT ID) /data" +### (Submit a batch job : "qsub sub.q") Use shoot script for GKV. +### Check job status : "qstat -a" +### Delete job : "qdel JOBID" +### Show budget info : "pstime" +### Show disk usage : "lsquota" ############## -#PJM --rsc-list "rscgrp=fx-debug" -#PJM --rsc-list "node=8" -#### --rsc-list "node=5x8x8" -#PJM --rsc-list "elapse=00:10:00" -#PJM --mpi "proc=32" -#### --mpi "rank-map-bynode" -#### --mpi "rank-map-hostfile=rankmapfile.dat" -#PJM -j -#PJM -s +#PBS -q small # queue name +#PBS --group=21234 # resource group +#PBS -T necmpi # necessary for MPI job +#PBS -l elapstim_req=00:15:00 # elapsed time limit + +#PBS --venode=2 # total number of VE +#### --venum-lhost=2 # number of VE per a logical node +#PBS --venum-lhost=8 # number of VE per a logical node +#PBS -v OMP_NUM_THREADS=1 # number of threads per MPI process -NUM_NODES=${PJM_NODE} # Nodes -NUM_CORES=12 # Cores per node -NUM_PROCS=$(( ${NUM_NODES} * 4 )) # MPI processes -export OMP_NUM_THREADS=12 # OpenMP threads per MPI +MPI_procs=16 # number of MPI processes (= venode*8 for flat MPI) +#PBS -v VE_FORT_SETBUF=10240 +#PBS -v FTRACE=YES +#PBS -v NMPI_PROGINF=DETAIL +#PBS -v NMPI_SEPSELECT=3 -echo " Nodes: ${NUM_NODES}" -echo " Cores per node: ${NUM_CORES}" -echo " MPI Processes: ${NUM_PROCS}" -echo " OpenMP threads per MPI: ${OMP_NUM_THREADS}" +#PBS -v LANG=C +source /ect/profile.d/modules.sh + +module load NECNLC-sx +# module load NECNLC-mpi-sx +### For NetCDF +module load netcdf-parallelIO-fortran-sx ### Working directory @@ -68,60 +67,36 @@ DIR=%%DIR%% LDM=gkvp.exe NL=gkvp_namelist.%%% -#export XOS_MMM_L_PAGING_POLICY=demand:demand:demand # For Largepage - -export PLE_MPI_STD_EMPTYFILE="off" # Suppress stdout of filesize-0 -module load fftw-tune phdf5 netcdf-c netcdf-fortran -###module unload tcs -###module load fftw/3.3.8 -###export PATH=/opt/FJSVxtclanga/tcsds-1.2.25/bin:$PATH -###export LD_LIBRARY_PATH=/opt/FJSVxtclanga/tcsds-1.2.25/lib64:$LD_LIBRARY_PATH -###export OPAL_PREFIX=/opt/FJSVxtclanga/tcsds-1.2.25 - - -#### Run date cd ${DIR} export fu05=${DIR}/${NL} -mpiexec -n ${NUM_PROCS} ${DIR}/${LDM} - # -n "Total number of MPI processes" -date -##### Run with Fujitsu profiler fipp (re-compile with -Nfjprof option) -#date -#cd ${DIR} -#export fu05=${DIR}/${NL} -#fipp -C -d ${DIR}/fjprof_dir/pa0 -Icpupa -Impi -Sregion mpiexec -n ${NUM_PROCS} ${DIR}/${LDM} -#date -#echo "#!/bin/sh" > ${DIR}/fjprof_dir/fugaku_fipppx.sh -#echo "set -Ceu" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh -#echo "set -x" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh -#echo "fipppx -A -d pa0 -Icpupa -p0,limit=4 -o prof_cpupa.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh -#echo "fipppx -A -d pa0 -Ibalance -p0,limit=4 -o prof_balance.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh -#echo "#fipppx -A -d pa0 -Icall -p0,limit=4 -o prof_call.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh -#echo "fipppx -A -d pa0 -Isrc:./src -p0,limit=4 -o prof_src.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh - - -##### Run with Fujitsu profiler fapp (re-compile with -Nfjprof option) -#date -#cd ${DIR} -#export fu05=${DIR}/${NL} -#Npa=1 # Elementary report -##Npa=5 # Simple report -##Npa=11 # Standard report -##Npa=17 # Detailed report -#for i in `seq 1 ${Npa}`; do -# echo "pa"${i} `date` -# fapp -C -d ${DIR}/fjprof_dir/pa${i} -Hevent=pa${i} -Sregion mpiexec -n ${NUM_PROCS} ${DIR}/${LDM} -#done -#date -# -#echo "#!/bin/sh" > ${DIR}/fjprof_dir/fugaku_fapppx.sh -#for i in `seq 1 ${Npa}`; do -# echo "fapppx -A -d ./pa${i} -Icpupa,mpi -tcsv -o pa${i}.csv" >> ${DIR}/fjprof_dir/fugaku_fapppx.sh -#done -#echo "cp /opt/FJSVxtclanga/tcsds-1.2.25/misc/cpupa/cpu_pa_report.xlsm ./" >> ${DIR}/fjprof_dir/fugaku_fapppx.sh -# +#cat << 'EOF-S' > ./mpisep.sh +##!/bin/sh +#ulimit -s unlimited +#ID=${MPIUNIVERSE}.`printf "%05d" ${MPIRANK}` +#case ${NMPI_SEPSELECT:-${MPISEPSELECT:-2}} in +#1) exec $* 1>> stdout.${ID} ;; +#2) exec $* 2>> stderr.${ID} ;; +#3) exec $* 1>> stdout.${ID} 2>> stderr.${ID} ;; +#4) exec $* 1>> std.${ID} 2>&1 ;; +#*) exec $* ;; +#esac +#EOF-S +#chmod 777 ./mpisep.sh # +##---( time mpiexec -v -nn ${_NECMPI_VH_NUM_NODES} -ve 0-7 -ppn 64 ./mpisep.sh ./${LDM} ) > log.mpi 2>&1 +#( time mpiexec -v -nn ${_NECMPI_VH_NUM_NODES} -ve 0-7 -ppn 64 -n ${MPI_procs} ./mpisep.sh ./${LDM} ) > log.mpi 2>&1 + +mpirun -n ${MPI_procs} ${DIR}/${LDM} + +date +#touch complete + + +#---#PBS -l coresz_prc=10 +#---#PBS --venum-lhost=8 +#---#PBS -b 4 # number of nodes + diff --git a/src/gkvp_advnc.f90 b/src/gkvp_advnc.f90 index 4ccdb26..44b0355 100644 --- a/src/gkvp_advnc.f90 +++ b/src/gkvp_advnc.f90 @@ -16,12 +16,13 @@ MODULE GKV_advnc use GKV_fld, only: fld_esfield, fld_emfield_hh, fld_hh2ff use GKV_exb, only: exb_NL_term use GKV_colli, only: colli_LB!, colli_full - use GKV_colliimp, only: colliimp_calc_colli_full + use GKV_colliimp, only: colliimp_calc_colli_full, colliimp_set_param use GKV_bndry, only: bndry_bound_e, & bndry_zv_buffin, bndry_zv_sendrecv, bndry_zv_buffout use GKV_clock, only: clock_sta, clock_end use GKV_zfilter, only: zfilter use GKV_tips, only: tips_reality + use GKV_geom, only: geom_increment_time implicit none @@ -93,6 +94,17 @@ SUBROUTINE advnc_rkgsteps_rev( colliflag, ff, phi, Al, hh ) do istep = 1, 4 + !%%% For shearflow rotating flux tube model %%% + if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "rotating") then + if (istep == 2 .or. istep == 4) then + call geom_increment_time(0.5_DP * dt) + if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then + call colliimp_set_param + end if + end if + end if + !%%% + call caldlt_rev( colliflag, ff, phi, Al, hh, dh, cf, ef ) call clock_sta(11) @@ -479,7 +491,7 @@ SUBROUTINE literm_zv ( ff, psi, im, lf ) dimension(-nx:nx,0:ny,-nz:nz-1,1:2*nv) :: lf real(kind=DP), dimension(-nz:nz-1) :: cefz, cefz2 - real(kind=DP) :: cefv, cs1 + real(kind=DP) :: cefv, cs1, rotating_cf4, rotating_up5 integer :: mx, my, iz, iv @@ -494,6 +506,15 @@ SUBROUTINE literm_zv ( ff, psi, im, lf ) cefz2(iz) = 1._DP / ( 60._DP * dpara(iz) ) * sqrt( tau(ranks) / Anum(ranks) ) end do cefv = 1._DP / ( 12._DP * dv ) * sqrt( tau(ranks) / Anum(ranks) ) + !%%% For shearflow rotating flux tube model %%% + if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "rotating") then + rotating_cf4 = - gamma_e / (s_hat_g * 12._DP * (zz(0)-zz(-1))) + rotating_up5 = - gamma_e / (s_hat_g * 60._DP * (zz(0)-zz(-1))) + else + rotating_cf4 = 0._DP + rotating_up5 = 0._DP + end if + !%%% if (trim(z_calc) == "cf4") then @@ -503,7 +524,10 @@ SUBROUTINE literm_zv ( ff, psi, im, lf ) do my = ist_y, iend_y do mx = -nx, nx lf(mx,my,iz,iv) = lf(mx,my,iz,iv) & - - vl(iv) * cefz(iz) * ( & + !%%% For shearflow rotating flux tube model %%% + !!!- vl(iv) * cefz(iz) * ( & + - (vl(iv) * cefz(iz) + rotating_cf4) * ( & + !%%% - ff(mx,my,iz+2,iv) & + 8._DP * ff(mx,my,iz+1,iv) & - 8._DP * ff(mx,my,iz-1,iv) & @@ -540,6 +564,13 @@ SUBROUTINE literm_zv ( ff, psi, im, lf ) do my = ist_y, iend_y do mx = -nx, nx lf(mx,my,iz,iv) = lf(mx,my,iz,iv) & + !%%% For shearflow rotating flux tube model %%% + - rotating_cf4 * ( & + - ff(mx,my,iz+2,iv) & + + 8._DP * ff(mx,my,iz+1,iv) & + - 8._DP * ff(mx,my,iz-1,iv) & + + ff(mx,my,iz-2,iv) ) & + !%%% - vl(iv) * cefz2(iz) * ( & - 3._DP * ff(mx,my,iz+2,iv) & +30._DP * ff(mx,my,iz+1,iv) & @@ -568,6 +599,13 @@ SUBROUTINE literm_zv ( ff, psi, im, lf ) do my = ist_y, iend_y do mx = -nx, nx lf(mx,my,iz,iv) = lf(mx,my,iz,iv) & + !%%% For shearflow rotating flux tube model %%% + - rotating_cf4 * ( & + - ff(mx,my,iz+2,iv) & + + 8._DP * ff(mx,my,iz+1,iv) & + - 8._DP * ff(mx,my,iz-1,iv) & + + ff(mx,my,iz-2,iv) ) & + !%%% - vl(iv) * cefz2(iz) * ( & + 2._DP * ff(mx,my,iz+3,iv) & -15._DP * ff(mx,my,iz+2,iv) & diff --git a/src/gkvp_geom.f90 b/src/gkvp_geom.f90 new file mode 100644 index 0000000..b4462cc --- /dev/null +++ b/src/gkvp_geom.f90 @@ -0,0 +1,2624 @@ +MODULE GKV_geom +!------------------------------------------------------------------------------- +! +! Calculate geometric constants +! +! Update history of gkvp_geom.f90 +! -------------- +! gkvp_f0.62 (S. Maeyama, March 2022) +! - First implementation. +! - Geometric constants, which had been set in gkvp_set.f90, are moved. +! This module will be called from gkvp_set.f90 for initialization, +! and from gkvp_shearflow.f90 for update in rotating flux-tube model. +! - Subroutines geom_* are public, can be called from other module. +! - Subroutines metric_* are private, treating metric structure. +! +!------------------------------------------------------------------------------- + + use GKV_header + use GKV_mpienv + use GKV_math, only: math_j0, math_j1, math_j2, math_g0 + use GKV_intgrl, only: intgrl_fsrf, intgrl_v0_moment_ms +! for vmec equilibrium w/ Booz_xform by M. Nakata & M. Nunami (Aug. 2016) + use GKV_vmecbzx, only: vmecbzx_boozx_read, vmecbzx_boozx_coeff +! for tokamak(eqdsk) equilibrium + use GKV_igs, only: igs_read, igs_coeff + + implicit none + + private + + public geom_read_nml, geom_init_kxkyzvm, & + geom_init_metric, geom_set_operators, & + geom_reset_time, geom_increment_time + + + type metric_global + ! Global metrics at t=0 are stored. + ! Metrics in GKV coordinates (x,y,z) + ! Metrics in flux coordinates (r,t,q)=(rho,theta,zeta) + real(kind=DP), dimension(-global_nz:global_nz-1) :: zz ! The rotating flux tube coordinate (= z'') + real(kind=DP), dimension(-global_nz:global_nz-1) :: theta ! The geometrical poloidal angle theta_pol, not the flux-coordinate theta + real(kind=DP), dimension(-global_nz:global_nz-1) :: omg ! Magnetic field strength + real(kind=DP), dimension(-global_nz:global_nz-1) :: & + domgdx, domgdy, domgdz, gxx, gxy, gxz, gyy, gyz, gzz, rootg_xyz + real(kind=DP), dimension(-global_nz:global_nz-1) :: & + domgdr, domgdt, domgdq, grr, grt, grq, gtt, gtq, gqq, rootg_rtq + contains + procedure :: init => metric_global_init + procedure :: xyz2rtq => metric_global_xyz2rtq + procedure :: rtq2xyz => metric_global_rtq2xyz + end type + + type metric_fourier + ! Metrics in flux coordinates at t=0, stored in Fourier coefficient + ! e.g., fourier_omg(kz) = \int omg(z) * exp(-i*kz*z) dz / \int dz + ! omg(z) = \sum_k fourier_omg(kz) * exp(i*kz*z) + ! Thus, omg(z) at arbitrary z is obtained by Fourier interpolation. + real(kind=DP), dimension(-global_nz:global_nz-1) :: kz + complex(kind=DP), dimension(-global_nz:global_nz-1) :: theta_tilde, omg + complex(kind=DP), dimension(-global_nz:global_nz-1) :: & + domgdr, domgdt, domgdq, grr, grt, grq, gtt, gtq, gqq, rootg_rtq + contains + procedure :: init => metric_fourier_init + procedure :: dft_rtq2coef => metric_fourier_dft_rtq2coef + end type + + type metric_local + ! Local metrics at any time t are stored. + ! They are updated with time integration, and used for solving + ! Gyrokinetic equation in the rotating flux tube model. + real(kind=DP), dimension(-nz:nz-1) :: zz ! The rotating flux tube coordinate (= z'') + real(kind=DP), dimension(-nz:nz-1) :: zz_labframe ! The flux-coordinate theta in the lab frame (= z''+t*gamma_e/s_hat) + real(kind=DP), dimension(-nz:nz-1) :: theta ! The geometrical poloidal angle theta_pol, not the flux-coordinate theta + real(kind=DP), dimension(-nz:nz-1) :: omg ! Magnetic field strength + real(kind=DP), dimension(-nz:nz-1) :: & + domgdx, domgdy, domgdz, gxx, gxy, gxz, gyy, gyz, gzz, rootg_xyz + real(kind=DP), dimension(-nz:nz-1) :: & + domgdr, domgdt, domgdq, grr, grt, grq, gtt, gtq, gqq, rootg_rtq + contains + procedure :: copy_global => metric_local_copy_global + procedure :: init => metric_local_init + procedure :: update => metric_local_update + procedure :: dft_coef2rtq => metric_local_dft_coef2rtq + procedure :: rtq2xyz => metric_local_rtq2xyz + end type + + type(metric_global), save :: mtr_global + type(metric_fourier), save :: mtr_fourier + type(metric_local), save :: mtr_local + + real(kind=DP), save :: cx, cy, cb + + +! for s-alpha model with Shafranov shift + real(kind=DP) :: p_total, dp_totaldx, beta_total, alpha_MHD + + real(kind=DP) :: r_major + + integer, parameter :: num_omtr = 13 + real(kind=DP) :: metric_l(1:num_omtr,-nz:nz-1), metric_g(1:num_omtr,-global_nz:global_nz-1) + + real(kind=DP) :: s_hat + + real(kind=DP) :: eps_r + + real(kind=DP) :: lz, kxmin, kymin, dz, mmax, dm, del_c + real(kind=DP) :: z0, z0_l + integer :: n_tht, m_j + + real(kind=DP) :: rdeps00, eps_hor, lprd, mprd, lmmq, malpha + real(kind=DP) :: eps_mor, eps_por, lprdm1, lprdp1, lmmqm1, lmmqp1 + real(kind=DP) :: eps_rnew, rdeps1_0, rdeps1_10, rdeps2_10, rdeps3_10 + + real(kind=DP) :: s_input, s_0 ! radial label of fluxtube center + integer :: mc_type ! 0:Axisym., 1:Boozer, 2:Hamada + integer :: q_type ! 0:use q and s_hat value in confp, 1:calclated by IGS + integer :: isw, nss, ntheta, nzeta + real(kind=DP) :: phi_ax ! axisymmetric toroidal angle + + real(kind=DP) :: lz_l + + +CONTAINS + + +!-------------------------------------- + SUBROUTINE geom_read_nml +!-------------------------------------- + implicit none + + real(kind=DP) :: theta + real(kind=DP), dimension(0:ns-1) :: eta + real(kind=DP) :: domgdx, domgdy, domgdz + real(kind=DP), dimension(1:3,1:3) :: gg + integer :: iz, is, isw + + + namelist /physp/ R0_Ln, & ! R0/Lns + R0_Lt, & ! R0/Lts + nu, & ! factor for collision freq. in LB model + Anum, & ! mass number + Znum, & ! charge number + fcs, & ! charge-density fraction + sgn, & ! signs of charge + tau, & ! T-ratio Ts/T0, T0=reference ion temp. of ranks=1 + dns1, & ! initial perturbation amplitude + tau_ad, & ! Ti/Te for ITG-ae, Te/Ti for ETG-ai + lambda_i, & ! (Debye/rho_tp)^2 + beta, & ! mu0*ni*Ti/B^2 + ibprime, & ! flag for finite beta-prime effect on kvd + vmax, & ! maximum v_para in unit of v_ts + nx0 ! mode number for the initial perturbation + + namelist /rotat/ mach, uprime, gamma_e + + namelist /nperi/ n_tht, kymin, m_j, del_c + namelist /confp/ eps_r, eps_rnew, & + q_0, s_hat, & + lprd, mprd, eps_hor, eps_mor, eps_por, & + rdeps00, rdeps1_0, rdeps1_10, & + rdeps2_10, rdeps3_10, malpha +! namelist /vmecp/ q_0, rad_a, & +! R0_unit, r_edge, & +! b0b00, alpha_fix + namelist /vmecp/ s_input, nss, ntheta, nzeta + + namelist /igsp/ s_input, mc_type, q_type, nss, ntheta + + tau(:) = 1.0_DP + nu(:) = 0.002_DP + R0_Ln(:) = 2.5_DP + R0_Lt(:) = 7.5_DP + + + read(inml,nml=physp) + + + do is = 0, ns-1 + if( R0_Ln(is) /= 0._DP ) then + eta(is) = R0_Lt(is) / R0_Ln(is) + else + eta(is) = 1.d+20 + end if + end do + + + write( olog, * ) " # Physical parameters" + write( olog, * ) "" + write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) + write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) + write( olog, * ) " # eta = ", eta(:) + write( olog, * ) " # nu = ", nu(:) + write( olog, * ) " # A-number = ", Anum(:) + write( olog, * ) " # Z-number = ", Znum(:) + write( olog, * ) " # fcs = ", fcs(:) + write( olog, * ) " # sgn = ", sgn(:) + write( olog, * ) " # tau = ", tau(:) + write( olog, * ) " # dns1 = ", dns1(:) + write( olog, * ) " # tau_ad = ", tau_ad + write( olog, * ) " # lambda_i^2 = ", lambda_i + write( olog, * ) " # beta_i = ", beta + write( olog, * ) " # ibprime = ", ibprime + write( olog, * ) " # nx0 = ", nx0 + write( olog, * ) "" + + + mach = 0._DP + uprime = 0._DP + gamma_e = 0._DP + + read(inml,nml=rotat) + + write( olog, * ) " # Mean rotation parameters" + write( olog, * ) "" + write( olog, * ) " # Mach number = ", mach + write( olog, * ) " # uptime = ", uprime + write( olog, * ) " # gamma_ExB = ", gamma_e + write( olog, * ) "" + + + n_tht = 1 + + read(inml,nml=nperi) + + + if( trim(equib_type) == "slab") then + + read(inml,nml=confp) + + lprdm1 = 0._DP + lprdp1 = 0._DP + + lmmq = 0._DP + lmmqm1 = 0._DP + lmmqp1 = 0._DP + + q_0 = 1._DP ! For now, fixed q_0=1. Changing q_0 can extend parallel z-box size. + s_hat = 0._DP ! only shear less slab + eps_r = 1._DP + + eps_hor = 0._DP + lprd = 0._DP + mprd = 0._DP + malpha = 0._DP + + rdeps00 = 0._DP + eps_mor = 0._DP + eps_por = 0._DP + + write( olog, * ) " # Configuration parameters" + write( olog, * ) "" + write( olog, * ) " # q_0 = ", q_0 + write( olog, * ) " # s_hat = ", s_hat + write( olog, * ) " # eps_r = ", eps_r + write( olog, * ) "" + + write( olog, * ) " # eps_hor = ", eps_hor + write( olog, * ) " # lprd = ", lprd + write( olog, * ) " # mprd = ", mprd + write( olog, * ) " # malpha = ", malpha + write( olog, * ) " # rdeps00 = ", rdeps00 + + write( olog, * ) " # eps_mor = ", eps_mor + write( olog, * ) " # lprdm1 = ", lprdm1 + write( olog, * ) " # eps_por = ", eps_por + write( olog, * ) " # lprdp1 = ", lprdp1 + write( olog, * ) "" + + else if( trim(equib_type) == "analytic" .OR. & + trim(equib_type) == "s-alpha" .OR. & + trim(equib_type) == "s-alpha-shift" .OR. & + trim(equib_type) == "circ-MHD" ) then + + + read(inml,nml=confp) + + + lprdm1 = lprd - 1.0_DP + lprdp1 = lprd + 1.0_DP + + lmmq = lprd - mprd * q_0 + lmmqm1 = lprdm1 - mprd * q_0 + lmmqp1 = lprdp1 - mprd * q_0 + + + write( olog, * ) " # Configuration parameters" + write( olog, * ) "" + write( olog, * ) " # q_0 = ", q_0 + write( olog, * ) " # s_hat = ", s_hat + write( olog, * ) " # eps_r = ", eps_r + write( olog, * ) "" + + write( olog, * ) " # eps_hor = ", eps_hor + write( olog, * ) " # lprd = ", lprd + write( olog, * ) " # mprd = ", mprd + write( olog, * ) " # malpha = ", malpha + write( olog, * ) " # rdeps00 = ", rdeps00 + + write( olog, * ) " # eps_mor = ", eps_mor + write( olog, * ) " # lprdm1 = ", lprdm1 + write( olog, * ) " # eps_por = ", eps_por + write( olog, * ) " # lprdp1 = ", lprdp1 + write( olog, * ) "" + + + else if( trim(equib_type) == "vmec" ) then + + + read(inml,nml=confp) + + read(inml,nml=vmecp) + + call vmecbzx_boozx_read( nss, ntheta, nzeta ) + + isw = 0 + iz = 0 + call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, 0._DP, lz_l, & ! input + s_0, q_0, s_hat, eps_r, phi_ax, & ! output + omg(iz), rootg(iz), domgdx, domgdz, domgdy, & + gg(1,1), gg(1,2), gg(1,3), gg(2,2), & + gg(2,3), gg(3,3) ) + + + + write( olog, * ) " # Configuration parameters" + write( olog, * ) "" + write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) + write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) + write( olog, * ) " # eta = ", eta(:) + write( olog, * ) " # q_0 = ", q_0 + write( olog, * ) " # s_hat = ", s_hat + write( olog, * ) " # eps_r = ", eps_r + write( olog, * ) " # s_input, s_0 = ", s_input, s_0 + write( olog, * ) " # nss, ntheta, nzeta = ", nss, ntheta, nzeta + + + else if( trim(equib_type) == "eqdsk" ) then + + + read(inml,nml=confp) + + read(inml,nml=igsp) + + call igs_read( mc_type, nss, ntheta ) + + if ( q_type == 1 ) then + isw = 0 + iz = 0 + call igs_coeff( isw, mc_type, nss, ntheta, s_input, 0._DP, lz_l, & ! input + s_0, q_0, s_hat, eps_r, theta, & ! output + omg(iz), rootg(iz), domgdx, domgdz, domgdy, & + gg(1,1), gg(1,2), gg(1,3), gg(2,2), & + gg(2,3), gg(3,3) ) + end if + + + + write( olog, * ) " # Configuration parameters" + write( olog, * ) "" + write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) + write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) + write( olog, * ) " # eta = ", eta(:) + write( olog, * ) " # q_0 = ", q_0 + write( olog, * ) " # s_hat = ", s_hat + write( olog, * ) " # eps_r = ", eps_r + write( olog, * ) " # s_input, s_0 = ", s_input, s_0 + write( olog, * ) " # nss, ntheta = ", nss, ntheta + + else + + write( olog, * ) " # wrong choice of the equilibrium " + call flush(olog) + call MPI_Finalize(ierr_mpi) + stop + + end if + + END SUBROUTINE geom_read_nml + + +!-------------------------------------- + SUBROUTINE geom_init_kxkyzvm(lx, ly, eps_r_temp) +!-------------------------------------- + implicit none + real(kind=DP), intent(out) :: lx, ly, eps_r_temp + integer :: global_iv, global_im + integer :: mx, my, iz, iv, im, is, ierr_mpi + + eps_r_temp = eps_r + + if (abs(s_hat) < 1.d-10) then ! When s_hat == ZERO + m_j = 0 + kxmin = kymin + else if (m_j == 0) then + kxmin = kymin + else + kxmin = abs(2._DP * pi * s_hat * kymin / real(m_j, kind=DP)) + end if + lx = pi / kxmin + ly = pi / kymin + ! kymin=pi/ly=pi/[r_minor*pi/(q0*n_alp)]=q0*n_alp/r_minor + + lz = real( n_tht, kind=DP ) * pi ! total z-length + lz_l = lz / real( nprocz, kind=DP ) ! local z-length + + do mx = -nx, nx + kx(mx) = kxmin * real( mx, kind=DP ) + end do + + ky(:) = 0._DP + do my = ist_y_g, iend_y_g + ky(my-ist_y_g) = kymin * real( my, kind=DP ) + end do + + kxmin_g = kxmin + kymin_g = kymin + + z0 = - lz ! global lower boundary + z0_l = 2._DP * lz_l * real( rankz, kind=DP ) + z0 + ! local lower boundary + + dz = lz_l / real( nz, kind=DP ) + + do iz = -nz, nz-1 + zz(iz) = dz * real( iz + nz, kind=DP ) + z0_l + end do + + + dv = 2._DP * vmax / real( 2 * nv * nprocv -1, kind=DP ) + + do iv = 1, 2*nv + global_iv = 2 * nv * rankv + iv + vl(iv) = dv * ( real( global_iv - nv * nprocv - 1, kind=DP ) + 0.5_DP ) + end do + ! --- debug + ! write( olog, * ) " *** iv, vl " + ! do iv = 1, 2*nv + ! global_iv = 2 * nv * rankv + iv + ! write( olog, * ) iv, global_iv, vl(iv) + ! end do + ! write( olog, * ) "" + + mmax = vmax + dm = mmax / real( nprocm * ( nm+1 ) - 1, kind=DP ) + ! --- equal spacing in vperp + + do im = 0, nm + global_im = ( nm+1 ) * rankm + im + mu(im) = 0.5_DP * ( dm * real( global_im, kind=DP ) )**2 + end do + + + do my = ist_y_g, iend_y_g + ck(my-ist_y_g) = exp( ui * 2._DP * pi * del_c & + * real( n_tht * my, kind=DP ) ) + dj(my-ist_y_g) = - m_j * n_tht * my + ! del_c = q_0*n_alp-int(q_0*n_alp) + ! m_j = 2*n_alp*q_d + end do + + + write( olog, * ) " # Numerical parameters" + write( olog, * ) "" + write( olog, * ) " # n_tht = ", n_tht + write( olog, * ) " # lx, ly, lz = ", lx, ly, lz + write( olog, * ) " # lz, z0 = ", lz, z0 + write( olog, * ) " # lz_l, z0_l = ", lz_l, z0_l + write( olog, * ) " # kxmin, kymin = ", kxmin, kymin + write( olog, * ) " # kxmax, kymax = ", kxmin*nx, kymin*global_ny + write( olog, * ) " # kperp_max = ", sqrt((kxmin*nx)**2+(kymin*global_ny)**2) + write( olog, * ) " # m_j, del_c = ", m_j, del_c + write( olog, * ) " # dz = ", dz + write( olog, * ) " # dv, vmax = ", dv, vmax + write( olog, * ) " # dm, mmax = ", dm, mmax + write( olog, * ) "" + + if (gamma_e == 0._DP) then + tlim_exb = 999999.d0 + else + tlim_exb = (kxmin*(nx-nx0))/(kymin*global_ny*abs(gamma_e)) + end if + write( olog, * ) " # ExB limit time tlim_exb = ", tlim_exb + write( olog, * ) " # for (mx=nx0,my=global_ny) initial perturbation: " + write( olog, * ) " # tlim_exb = kxmin*(nx-nx0)/(kymax*|gamma_e|)" + write( olog, * ) "" + + END SUBROUTINE geom_init_kxkyzvm + + +!-------------------------------------- + SUBROUTINE geom_init_metric_old +!-------------------------------------- + implicit none + real(kind=DP) :: theta, domgdz, domgdx, domgdy + real(kind=DP), dimension(1:3,1:3) :: gg + + integer :: iz, is + + + do iz = -nz, nz-1 + +!!! for slab model + if ( trim(equib_type) == "slab") then + + q_bar = q_0 + r_major = 1._DP ! in the R0 unit + theta = zz(iz) + + omg(iz) = 1._DP + rootg(iz) = q_0*r_major + + !- for OUTPUT hst/*.mtr.* - + domgdz = 0._DP + domgdy = 0._DP + domgdx = 0._DP + gg(1,1) = 1._DP + gg(1,2) = 0._DP + gg(1,3) = 0._DP + gg(2,1) = gg(1,2) + gg(2,2) = 1._DP + gg(2,3) = 0._DP + gg(3,1) = gg(1,3) + gg(3,2) = gg(2,3) + gg(3,3) = 1._DP + metric_l( 1,iz) = zz(iz) ! [ 1] + metric_l( 2,iz) = theta ! [ 2] + metric_l( 3,iz) = omg(iz) ! [ 3] + metric_l( 4,iz) = domgdx ! [ 4] + metric_l( 5,iz) = domgdy ! [ 5] + metric_l( 6,iz) = domgdz ! [ 6] + metric_l( 7,iz) = gg(1,1) ! [ 7] + metric_l( 8,iz) = gg(1,2) ! [ 8] + metric_l( 9,iz) = gg(1,3) ! [ 9] + metric_l(10,iz) = gg(2,2) ! [10] + metric_l(11,iz) = gg(2,3) ! [11] + metric_l(12,iz) = gg(3,3) ! [12] + metric_l(13,iz) = rootg(iz)! [13] + !------------------------- + + +!!! for the concentric and large-aspect-ratio model !!! + else if( trim(equib_type) == "analytic" ) then + + q_bar = q_0 + r_major = 1._DP ! in the R0 unit + + theta = zz(iz) + + omg(iz) = 1._DP & + - eps_r * ( cos( zz(iz) ) & + + eps_hor * cos( lmmq * zz(iz) - malpha ) & + + eps_mor * cos( lmmqm1 * zz(iz) - malpha ) & + + eps_por * cos( lmmqp1 * zz(iz) - malpha ) ) + + rootg(iz) = q_0*r_major/omg(iz) + + !- for OUTPUT hst/*.mtr.* - !%%% under benchmark %%% + domgdz = eps_r * ( sin(zz(iz)) & + + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & + + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & + + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) + domgdy = - eps_rnew / r_major * ( & + - ( sin( zz(iz) ) & + + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) & + ) - (-1._DP/eps_r) * domgdz ) + domgdx = eps_rnew / r_major * ( & + - ( & + rdeps00 & + + rdeps1_0 * cos( zz(iz) ) & + + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & + + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & + + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) & + + s_hat * zz(iz) * ( sin( zz(iz) ) & + + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & + ) - (-s_hat*zz(iz)/eps_r) * domgdz ) + gg(1,1) = 1._DP + gg(1,2) = s_hat*zz(iz) + gg(1,3) = 0._DP + gg(2,1) = gg(1,2) + gg(2,2) = 1._DP + (s_hat*zz(iz))**2 + gg(2,3) = 1._DP/(r_major*eps_r) + gg(3,1) = gg(1,3) + gg(3,2) = gg(2,3) + gg(3,3) = 1._DP/((r_major*eps_r)**2) + metric_l( 1,iz) = zz(iz) ! [ 1] + metric_l( 2,iz) = theta ! [ 2] + metric_l( 3,iz) = omg(iz) ! [ 3] + metric_l( 4,iz) = domgdx ! [ 4] + metric_l( 5,iz) = domgdy ! [ 5] + metric_l( 6,iz) = domgdz ! [ 6] + metric_l( 7,iz) = gg(1,1) ! [ 7] + metric_l( 8,iz) = gg(1,2) ! [ 8] + metric_l( 9,iz) = gg(1,3) ! [ 9] + metric_l(10,iz) = gg(2,2) ! [10] + metric_l(11,iz) = gg(2,3) ! [11] + metric_l(12,iz) = gg(3,3) ! [12] + metric_l(13,iz) = rootg(iz)! [13] + !------------------------- + +!!! for s-alpha !!! <--- the current version is the same as "analytic" + else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then + + q_bar = q_0 + r_major = 1._DP ! in the R0 unit + + if (trim(equib_type) == "s-alpha") then + !--- s-alpha model without Shafranov shift - + alpha_MHD = 0._DP + else if (trim(equib_type) == "s-alpha-shift") then + !--- s-alpha model with Shafranov shift ---- + p_total = 0._DP + dp_totaldx = 0._DP + beta_total = 0._DP + do is = 0, ns-1 + p_total = p_total + fcs(is) * tau(is) / Znum(is) + dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) + beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) + end do + alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total + end if + + theta = zz(iz) + + omg(iz) = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion + !omg(iz) = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark + + rootg(iz) = q_0*r_major/omg(iz) + + domgdz = eps_r * sin( theta ) + !domgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark + domgdx = -cos( theta ) / r_major + domgdy = 0._DP + + gg(1,1) = 1._DP + gg(1,2) = s_hat*zz(iz) - alpha_MHD*sin(zz(iz)) ! with Shafranov shift + gg(1,3) = 0._DP + gg(2,1) = gg(1,2) + gg(2,2) = 1._DP + (s_hat*zz(iz) - alpha_MHD*sin(zz(iz)))**2 ! with Shafranov shift + gg(2,3) = 1._DP/(r_major*eps_r) + gg(3,1) = gg(1,3) + gg(3,2) = gg(2,3) + gg(3,3) = 1._DP/((r_major*eps_r)**2) + + !- for OUTPUT hst/*.mtr.* - + metric_l( 1,iz) = zz(iz) ! [ 1] + metric_l( 2,iz) = theta ! [ 2] + metric_l( 3,iz) = omg(iz) ! [ 3] + metric_l( 4,iz) = domgdx ! [ 4] + metric_l( 5,iz) = domgdy ! [ 5] + metric_l( 6,iz) = domgdz ! [ 6] + metric_l( 7,iz) = gg(1,1) ! [ 7] + metric_l( 8,iz) = gg(1,2) ! [ 8] + metric_l( 9,iz) = gg(1,3) ! [ 9] + metric_l(10,iz) = gg(2,2) ! [10] + metric_l(11,iz) = gg(2,3) ! [11] + metric_l(12,iz) = gg(3,3) ! [12] + metric_l(13,iz) = rootg(iz)! [13] + !------------------------- + + +!!! for circular MHD equilibrium !!! + else if( trim(equib_type) == "circ-MHD" ) then + + q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 + r_major = 1._DP ! in the R0 unit + + theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & + * tan(zz(iz)/2._DP) ) + + omg(iz) = sqrt( q_bar**2 + eps_r**2 ) & + / ( 1._DP + eps_r*cos( theta ) ) / q_bar + + rootg(iz) = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 + + domgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & + / ( 1._DP + eps_r * cos( theta ) )**2 & + / ( 1._DP - eps_r * cos( zz(iz)) ) / q_0 + + domgdx = -( cos(theta) & + - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & + *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & + - eps_r*sin(theta)**2/(1._DP-eps_r**2) & + ) / ((1._DP + eps_r*cos(theta))**2) & + * sqrt(q_bar**2+eps_r**2) / q_bar / r_major + + domgdy = 0._DP + + gg(1,1) = (q_0/q_bar)**2 + gg(1,2) = ( s_hat*zz(iz)*q_0/q_bar - eps_r*sin(zz(iz))/(1._DP-eps_r**2) )*q_0/q_bar + gg(1,3) = - sin(zz(iz))/(1._DP-eps_r**2)/r_major*q_0/q_bar + gg(2,1) = gg(1,2) + gg(2,2) = (s_hat*zz(iz)*q_0/q_bar)**2 - 2._DP*q_0/q_bar*s_hat*zz(iz)*eps_r*sin(zz(iz))/(1._DP-eps_r**2) & + + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & + + (eps_r*sin(zz(iz)))**2/(1._DP-eps_r**2)**2 + gg(2,3) = ( -s_hat*zz(iz)*q_0/q_bar*sin(zz(iz))/(1._DP-eps_r**2) & + + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & + + eps_r*(sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & + ) / r_major + gg(3,1) = gg(1,3) + gg(3,2) = gg(2,3) + gg(3,3) = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & + + (sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & + ) / (r_major**2) + + !- for OUTPUT hst/*.mtr.* - + metric_l( 1,iz) = zz(iz) ! [ 1] + metric_l( 2,iz) = theta ! [ 2] + metric_l( 3,iz) = omg(iz) ! [ 3] + metric_l( 4,iz) = domgdx ! [ 4] + metric_l( 5,iz) = domgdy ! [ 5] + metric_l( 6,iz) = domgdz ! [ 6] + metric_l( 7,iz) = gg(1,1) ! [ 7] + metric_l( 8,iz) = gg(1,2) ! [ 8] + metric_l( 9,iz) = gg(1,3) ! [ 9] + metric_l(10,iz) = gg(2,2) ! [10] + metric_l(11,iz) = gg(2,3) ! [11] + metric_l(12,iz) = gg(3,3) ! [12] + metric_l(13,iz) = rootg(iz)! [13] + !------------------------- + +! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) + else if( trim(equib_type) == "vmec" ) then + + q_bar = q_0 + isw = 1 + r_major = 1._DP ! in the R0 unit + + call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz(iz), lz_l, & ! input + s_0, q_0, s_hat, eps_r, phi_ax, & ! output + omg(iz), rootg(iz), domgdx, domgdz, domgdy, & + gg(1,1), gg(1,2), gg(1,3), gg(2,2), & + gg(2,3), gg(3,3) ) + + !- for OUTPUT hst/*.mtr.* - + metric_l( 1,iz) = zz(iz) ! [ 1] + metric_l( 2,iz) = phi_ax ! [ 2] Axisymetric toroidal angle + metric_l( 3,iz) = omg(iz) ! [ 3] + metric_l( 4,iz) = domgdx ! [ 4] + metric_l( 5,iz) = domgdy ! [ 5] + metric_l( 6,iz) = domgdz ! [ 6] + metric_l( 7,iz) = gg(1,1) ! [ 7] + metric_l( 8,iz) = gg(1,2) ! [ 8] + metric_l( 9,iz) = gg(1,3) ! [ 9] + metric_l(10,iz) = gg(2,2) ! [10] + metric_l(11,iz) = gg(2,3) ! [11] + metric_l(12,iz) = gg(3,3) ! [12] + metric_l(13,iz) = rootg(iz)! [13] + !------------------------- + + + else if( trim(equib_type) == "eqdsk" ) then + + q_bar = q_0 + isw = 1 + r_major = 1._DP ! in the R0 unit + + call igs_coeff( isw, mc_type, nss, ntheta, s_input, zz(iz), lz_l, & ! input + s_0, q_0, s_hat, eps_r, theta, & ! output + omg(iz), rootg(iz), domgdx, domgdz, domgdy, & + gg(1,1), gg(1,2), gg(1,3), gg(2,2), & + gg(2,3), gg(3,3) ) + + !- for OUTPUT hst/*.mtr.* - + metric_l( 1,iz) = zz(iz) ! [ 1] + metric_l( 2,iz) = theta ! [ 2] + metric_l( 3,iz) = omg(iz) ! [ 3] + metric_l( 4,iz) = domgdx ! [ 4] + metric_l( 5,iz) = domgdy ! [ 5] + metric_l( 6,iz) = domgdz ! [ 6] + metric_l( 7,iz) = gg(1,1) ! [ 7] + metric_l( 8,iz) = gg(1,2) ! [ 8] + metric_l( 9,iz) = gg(1,3) ! [ 9] + metric_l(10,iz) = gg(2,2) ! [10] + metric_l(11,iz) = gg(2,3) ! [11] + metric_l(12,iz) = gg(3,3) ! [12] + metric_l(13,iz) = rootg(iz)! [13] + !------------------------- + + + else + + write( olog, * ) " # wrong choice of the equilibrium " + call flush(olog) + call MPI_Finalize(ierr_mpi) + stop + + end if + + end do ! iz loop ends + +!- OUTPUT ascii data hst/*.mtr.* - + call MPI_gather(metric_l(1,-nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & + metric_g(1,-global_nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & + 0, zsp_comm_world, ierr_mpi) + if ( rankg == 0 ) then + do iz = -global_nz, global_nz-1 + write( omtr, fmt="(f15.8,SP,256E24.14e3)") metric_g(:,iz) + end do + call flush(omtr) + end if +!--------------------------------- + + END SUBROUTINE geom_init_metric_old + + +!-------------------------------------- + SUBROUTINE geom_init_metric +!-------------------------------------- + real(kind=DP) :: r_0 + real(kind=DP) :: wzz, theta, gomg + real(kind=DP) :: gdomgdx, gdomgdy, gdomgdz, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz, grootg_xyz + real(kind=DP) :: gdomgdr, gdomgdt, gdomgdq, & + ggrr, ggrt, ggrq, ggtt, ggtq, ggqq, grootg_rtq + integer :: iz, is + + s_hat_g = s_hat + + do iz = -global_nz, global_nz-1 + + wzz = dz * iz + + if ( trim(equib_type) == "slab") then + !- Shearless slab geometry- + ! Consider translationally symmetric flux surface + ! (r,t,q)=(x_car,y_car,z_car). + ! GKV coordinates are + ! x = x_car, -lx<=x/gyroradius=B_ax, + ! where B_ax is the value at the magnetic axis. + ! cb = (psi_p(r))'/(cx*cy) = B_ax + ! Normalized = 1 and cb = 1 in the B_ax unit. + !- + r_major = 1._DP ! Major radius of magnetic axis in the R0 unit + r_0 = r_major * eps_r ! Minor radius of flux-tube center + cx = 1._DP + cy = r_0/q_0 + cb = 1._DP + + q_bar = q_0 + theta = wzz + gomg = 1._DP & + - eps_r * ( cos( wzz ) & + + eps_hor * cos( lmmq * wzz - malpha ) & + + eps_mor * cos( lmmqm1 * wzz - malpha ) & + + eps_por * cos( lmmqp1 * wzz - malpha ) ) + !- Metrics in GKV coordinates (x,y,z) + gdomgdz = eps_r * ( sin(wzz) & + + eps_hor * lmmq * sin( lmmq * wzz - malpha ) & + + eps_mor * lmmqm1 * sin( lmmqm1 * wzz - malpha ) & + + eps_por * lmmqp1 * sin( lmmqp1 * wzz - malpha ) ) + gdomgdy = - eps_rnew / r_major * ( & + - ( sin( wzz ) & + + eps_hor * lprd * sin( lmmq * wzz - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * wzz - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * wzz - malpha ) & + ) - (-1._DP/eps_r) * gdomgdz ) + gdomgdx = eps_rnew / r_major * ( & + - ( & + rdeps00 & + + rdeps1_0 * cos( wzz ) & + + rdeps2_10 * cos( lmmq * wzz - malpha ) & + + rdeps1_10 * cos( lmmqm1 * wzz - malpha ) & + + rdeps3_10 * cos( lmmqp1 * wzz - malpha ) & + + s_hat * wzz * ( sin( wzz ) & + + eps_hor * lprd * sin( lmmq * wzz - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * wzz - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * wzz - malpha ) ) & + ) - (-s_hat*wzz/eps_r) * gdomgdz ) + ggxx = 1._DP + ggxy = s_hat*wzz + ggxz = 0._DP + ggyy = 1._DP + (s_hat*wzz)**2 + ggyz = 1._DP/r_0 + ggzz = 1._DP/r_0**2 + grootg_xyz = q_0*r_major/gomg + !- Metrics in flux coordinates (r,theta,zeta) + !ggrr = 1._DP + !ggrt = 0._DP + !ggrq = 0._DP + !ggtt = 1._DP/r_0**2 + !ggtq = 0._DP + !ggqq = 0._DP ! /=1._DP/r_major**2, because of large-aspect ratio approximation + !grootg_rtq = r_0*r_major/gomg + + + else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then + !- Analytic model of large-aspect-ratio tokamak system - + ! Consider concentric circular flux surface (r,theta,zeta). + ! GKV coordinates are + ! x = cx*(r-r0) + ! y = cy*(q(r)*theta-zeta) + ! z = theta + ! with cx=1, cy=cx*r0/q0. + ! In the large-aspect ratio limit, the geometrical length + ! in the field-aligned direction is dpara=q*r_major*dz. + ! r_major = 1 in the R0 unit. + ! Finite aspect ratio eps_r = r0/R0 is retained only in + ! magnetic field omg, domgdx, domgdy, domgdz, but not for metrics. + ! Flux-surface averaged magnetic field is =B_ax, + ! where B_ax is the value at the magnetic axis. + ! cb = (psi_p(r))'/(cx*cy) = B_ax + ! Normalized = 1 and cb = 1 in the B_ax unit. + !- + r_major = 1._DP ! Major radius of magnetic axis in the R0 unit + r_0 = r_major * eps_r ! Minor radius of flux-tube center + cx = 1._DP + cy = r_0/q_0 + cb = 1._DP + + if (trim(equib_type) == "s-alpha") then + !--- s-alpha model without Shafranov shift - + alpha_MHD = 0._DP + else if (trim(equib_type) == "s-alpha-shift") then + !--- s-alpha model with Shafranov shift ---- + p_total = 0._DP + dp_totaldx = 0._DP + beta_total = 0._DP + do is = 0, ns-1 + p_total = p_total + fcs(is) * tau(is) / Znum(is) + dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) + beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) + end do + alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total + end if + q_bar = q_0 + theta = wzz + gomg = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion + !!!!gomg = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark + !- Metrics in GKV coordinates (x,y,z) + gdomgdz = eps_r * sin( theta ) + !!!!gdomgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark + gdomgdx = - cos( theta ) / r_major + gdomgdy = 0._DP + ggxx = 1._DP + ggxy = s_hat*wzz - alpha_MHD*sin(wzz) ! with Shafranov shift + ggxz = 0._DP + ggyy = 1._DP + (s_hat*wzz - alpha_MHD*sin(wzz))**2 ! with Shafranov shift + ggyz = 1._DP/r_0 + ggzz = 1._DP/r_0**2 + grootg_xyz = q_0*r_major/gomg + !- Metrics in flux coordinates (r,theta,zeta) + !gdomgdr = - cos( theta ) / r_major + !gdomgdt = eps_r * sin( theta ) + !gdomgdq = 0._DP + !ggrr = 1._DP + !ggrt = 0._DP + !ggrq = 0._DP + sin(wzz)*alpha_MHD*q_0/r_0 ! with Shafranov shift + !ggtt = 1._DP/r_0**2 + !ggtq = 0._DP + !ggqq = 0._DP & ! /=1._DP/r_major**2, because of large-aspect ratio approximation + ! + sin(wzz)*(alpha_MHD*q_0/r_0)**2 ! with Shafranov shift + !grootg_rtq = r_0*r_major/gomg + + + else if( trim(equib_type) == "circ-MHD" ) then + !- Circular MHD equilibrium - + ! [Ref.] X. Lapillonne, et al., Phys. Plasmas 16, 032308 (2009). + ! + ! Consider concentric circular flux surface (r,theta,zeta). + ! GKV coordinates are + ! x = cx*(r-r0) + ! y = cy*(q(r)*theta-zeta) + ! z = theta + ! with cx=1, cy=cx*r0/q0. + ! In the large-aspect ratio limit, the geometrical length + ! in the field-aligned direction is dpara=q*r_major*dz. + ! r_major = 1 in the R0 unit. + ! In contrast to the s-alpha model, finite aspect ratio eps_r = r0/R0 + ! is retained in both of magnetic field and metrics. + ! Difference between the flux-surface averaged magnetic field + ! and the value at the magnetic axis B_ax also appears. + ! cb = (psi_p(r))'/(cx*cy) = B_ax + ! Normalized omg = B(z)/B_ax and cb = 1 in the B_ax unit. + !- + r_major = 1._DP ! in the R0 unit + r_0 = r_major * eps_r ! Minor radius of flux-tube center + cx = 1._DP + cy = r_0/q_0 + cb = 1._DP + + theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & + * tan(wzz/2._DP) ) + q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 + gomg = sqrt( q_bar**2 + eps_r**2 ) & + / ( 1._DP + eps_r*cos( theta ) ) / q_bar + !- Metrics in GKV coordinates (x,y,z) + gdomgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & + / ( 1._DP + eps_r * cos( theta ) )**2 & + / ( 1._DP - eps_r * cos( wzz) ) / q_0 + gdomgdx = -( cos(theta) & + - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & + *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & + - eps_r*sin(theta)**2/(1._DP-eps_r**2) & + ) / ((1._DP + eps_r*cos(theta))**2) & + * sqrt(q_bar**2+eps_r**2) / q_bar / r_major + gdomgdy = 0._DP + ggxx = (q_0/q_bar)**2 + ggxy = ( s_hat*wzz*q_0/q_bar - eps_r*sin(wzz)/(1._DP-eps_r**2) )*q_0/q_bar + ggxz = - sin(wzz)/(1._DP-eps_r**2)/r_major*q_0/q_bar + ggyy = (s_hat*wzz*q_0/q_bar)**2 & + - 2._DP*q_0/q_bar*s_hat*wzz*eps_r*sin(wzz)/(1._DP-eps_r**2) & + + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & + + (eps_r*sin(wzz))**2/(1._DP-eps_r**2)**2 + ggyz = ( -s_hat*wzz*q_0/q_bar*sin(wzz)/(1._DP-eps_r**2) & + + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & + + eps_r*(sin(wzz)**2)/((1._DP-eps_r**2)**2) & + ) / r_major + ggzz = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & + + (sin(wzz)**2)/((1._DP-eps_r**2)**2) & + ) / (r_major**2) + grootg_xyz = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 + + + else if( trim(equib_type) == "vmec" ) then + !- VMEC-BoozXform interface for stellarator equilibirum - + ! References on the previous implementation by VMEC-NEWBOZ is + ! [Ref.1] M. Nunami, T.-H. Watanabe, H. Sugama, Plasma Fusion Res. 5, + ! 016 (2010). + ! New interface for VMEC-BoozXform is developed by M. Nakata and + ! M. Nunami (Aug. 2016) in the same manner for IGS. + ! + ! Consider flux coordinates (rho,theta,zeta). + ! Using the toroidal flux psi_t, the normalized minor radius is + ! rho= sqrt(psi_t/psi_ta), and the minor radius at the last closed + ! flux surface is a=sqrt(2*psi_ta/B_ax). + ! Poloidal and toroidal angles are defined in the Boozer coordinates. + ! GKV coordinates (x,y,z) are + ! x = cx*(rho-rho0) + ! y = cy*(q(r)*theta-zeta) + ! z = theta + ! with cx=a, cy=cx*rho0/q0. + ! In these definitions, the factor on the magnetic field + ! B = cb * \nabla x \times \nabla y is + ! cb = (psi_p(rho))'/(cx*cy) = B_ax. + ! Normalized omg = B(z)/B_ax and cb = 1 in the B_ax unit. + ! The reference length is set to be r_major at the magnetic axis R0. + !- + r_major = 1._DP ! in the R0 unit + q_bar = q_0 + isw = 1 + call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, wzz, lz_l, & ! input + s_0, q_0, s_hat, eps_r, phi_ax, & ! output + gomg, grootg_xyz, gdomgdx, gdomgdz, gdomgdy, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz ) + ! NOTE: phi_ax axisymmetric toroidal angle is stored for vmec, rather than theta + theta = phi_ax + cx = eps_r/s_0 ! = eps_a = a/R0 + cy = cx*s_0/q_0 + cb = 1._DP + + else if( trim(equib_type) == "eqdsk" ) then + !- EQDSK-IGS interface for tokamak equilibirum - + ! [Ref.] M. Nakata, A. Matsuyama, N. Aiba, S. Maeyama, M. Nunami, + ! and T.-H. Watanabe, Plasma Fusion Res. 9, 1403029 (2014). + ! + ! Consider flux coordinates (rho,theta,zeta). + ! GKV coordinates (x,y,z) are + ! x = cx*(rho-rho0) + ! y = cy*(q(r)*theta-zeta) + ! z = theta + ! with cx=a, cy=cx*rho0/q0. All explanation is the same as that in + ! equib_type == "vmec", except that poloidal and toroidal angles have + ! a choice of freedom: Hamada, Boozer, or axisymmetric coordinates. + !- + r_major = 1._DP ! in the R0 unit + q_bar = q_0 + isw = 1 + call igs_coeff( isw, mc_type, nss, ntheta, s_input, wzz, lz_l, & ! input + s_0, q_0, s_hat, eps_r, theta, & ! output + gomg, grootg_xyz, gdomgdx, gdomgdz, gdomgdy, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz ) + cx = eps_r/s_0 ! = eps_a = a/R0 + cy = cx*s_0/q_0 + cb = 1._DP + + else + + write( olog, * ) " # wrong choice of the equilibrium " + call flush(olog) + call MPI_Finalize(ierr_mpi) + stop + + end if + + call mtr_global%init(iz, wzz, theta, gomg, & + gdomgdx, gdomgdy, gdomgdz, ggxx, ggxy, & + ggxz, ggyy, ggyz, ggzz, grootg_xyz, & + gdomgdr, gdomgdt, gdomgdq, ggrr, ggrt, & + ggrq, ggtt, ggtq, ggqq, grootg_rtq) + call mtr_global%xyz2rtq + + end do ! iz loop ends + + call mtr_fourier%init + call mtr_fourier%dft_rtq2coef(mtr_global) + + call mtr_local%copy_global(mtr_global) + + if ( rankg == 0 ) then + do iz = -global_nz, global_nz-1 + !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & + write( 900000001, fmt="(f15.8,SP,256E24.14e3)") & + mtr_global%zz(iz), mtr_global%theta(iz), & + mtr_global%omg(iz), mtr_global%domgdx(iz), & + mtr_global%domgdy(iz), mtr_global%domgdz(iz), & + mtr_global%gxx(iz), mtr_global%gxy(iz), & + mtr_global%gxz(iz), mtr_global%gyy(iz), & + mtr_global%gyz(iz), mtr_global%gzz(iz), & + mtr_global%rootg_xyz(iz) + end do + !call flush(omtr) + do iz = -global_nz, global_nz-1 + !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & + write( 900000002, fmt="(f15.8,SP,256E24.14e3)") & + mtr_global%zz(iz), mtr_global%theta(iz), & + mtr_global%omg(iz), mtr_global%domgdr(iz), & + mtr_global%domgdt(iz), mtr_global%domgdq(iz), & + mtr_global%grr(iz), mtr_global%grt(iz), & + mtr_global%grq(iz), mtr_global%gtt(iz), & + mtr_global%gtq(iz), mtr_global%gqq(iz), & + mtr_global%rootg_rtq(iz) + end do + !call flush(omtr) + end if + + + + !%%% For debug %%% + do iz = -nz, nz-1 + write( 990000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & + mtr_local%zz(iz), mtr_local%theta(iz), & + mtr_local%omg(iz), mtr_local%domgdx(iz), & + mtr_local%domgdy(iz), mtr_local%domgdz(iz), & + mtr_local%gxx(iz), mtr_local%gxy(iz), & + mtr_local%gxz(iz), mtr_local%gyy(iz), & + mtr_local%gyz(iz), mtr_local%gzz(iz), & + mtr_local%rootg_xyz(iz) + write( 980000000+rankg, fmt="(f15.8,SP,256E24.14e3)") metric_l(:,iz) + end do + + call mtr_global%rtq2xyz + !call mtr_global%xyz2rtq + + call mtr_local%init(mtr_fourier, time_shearflow=0._DP) + + if ( rankg == 0 ) then + do iz = -global_nz, global_nz-1 + !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & + write( 900000011, fmt="(f15.8,SP,256E24.14e3)") & + mtr_global%zz(iz), mtr_global%theta(iz), & + mtr_global%omg(iz), mtr_global%domgdx(iz), & + mtr_global%domgdy(iz), mtr_global%domgdz(iz), & + mtr_global%gxx(iz), mtr_global%gxy(iz), & + mtr_global%gxz(iz), mtr_global%gyy(iz), & + mtr_global%gyz(iz), mtr_global%gzz(iz), & + mtr_global%rootg_xyz(iz) + end do + !call flush(omtr) + do iz = -global_nz, global_nz-1 + !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & + write( 900000012, fmt="(f15.8,SP,256E24.14e3)") & + mtr_global%zz(iz), mtr_global%theta(iz), & + mtr_global%omg(iz), mtr_global%domgdr(iz), & + mtr_global%domgdt(iz), mtr_global%domgdq(iz), & + mtr_global%grr(iz), mtr_global%grt(iz), & + mtr_global%grq(iz), mtr_global%gtt(iz), & + mtr_global%gtq(iz), mtr_global%gqq(iz), & + mtr_global%rootg_rtq(iz) + end do + !call flush(omtr) + end if + + do iz = -nz, nz-1 + write( 970000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & + mtr_local%zz(iz), mtr_local%theta(iz), & + mtr_local%omg(iz), mtr_local%domgdx(iz), & + mtr_local%domgdy(iz), mtr_local%domgdz(iz), & + mtr_local%gxx(iz), mtr_local%gxy(iz), & + mtr_local%gxz(iz), mtr_local%gyy(iz), & + mtr_local%gyz(iz), mtr_local%gzz(iz), & + mtr_local%rootg_xyz(iz) + end do + + do iz = -nz, nz-1 + write( 900090000+rankg, fmt="(f15.8,SP,256E24.14e3)") & + mtr_local%zz_labframe(iz), mtr_local%theta(iz), & + mtr_local%omg(iz), mtr_local%domgdr(iz), & + mtr_local%domgdt(iz), mtr_local%domgdq(iz), & + mtr_local%grr(iz), mtr_local%grt(iz), & + mtr_local%grq(iz), mtr_local%gtt(iz), & + mtr_local%gtq(iz), mtr_local%gqq(iz), & + mtr_local%rootg_rtq(iz) + end do + !%%%%%%%%%%%%%%%%%% + + END SUBROUTINE geom_init_metric + + +!-------------------------------------- + SUBROUTINE geom_set_operators_old +!-------------------------------------- + implicit none + real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy + real(kind=DP) :: bb, kmo + real(kind=DP) :: gg0 + + real(kind=DP) :: cfsrf_l + real(kind=DP), dimension(1:3,1:3) :: gg + complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf + complex(kind=DP), dimension(:,:,:), allocatable :: nw + real(kind=DP), dimension(:,:,:), allocatable :: ww + + + integer :: mx, my, iz, iv, im, is + do iz = -nz, nz-1 + + omg(iz) = metric_l( 3,iz) + domgdx = metric_l( 4,iz) + domgdy = metric_l( 5,iz) + domgdz = metric_l( 6,iz) + gg(1,1) = metric_l( 7,iz) + gg(1,2) = metric_l( 8,iz) + gg(1,3) = metric_l( 9,iz) + gg(2,2) = metric_l(10,iz) + gg(2,3) = metric_l(11,iz) + gg(3,3) = metric_l(12,iz) + rootg(iz) = metric_l(13,iz) + +!!! for slab model + if ( trim(equib_type) == "slab") then + + dpara(iz) = dz * q_0 * r_major + + do im = 0, nm + vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) + mir(iz,im) = 0._DP + do iv = 1, 2*nv + vdx(iz,iv,im) = 0._DP + vdy(iz,iv,im) = 0._DP + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 + end do + end do + +!!! for the concentric and large-aspect-ratio model !!! + else if( trim(equib_type) == "analytic" ) then + + dpara(iz) = dz * q_0 * r_major + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & + * ( sin(zz(iz)) & + + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & + + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & + + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) + + do iv = 1, 2*nv + vdx(iz,iv,im)= & + - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & + * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & + + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & + + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & + + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & + + ( 1._DP + s_hat * zz(iz) * 0._DP ) & + * ( sin( zz(iz) ) & + + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & + ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im)= & + - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & + * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & + + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & + + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & + + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & + + ( 0._DP + s_hat * zz(iz) * 1._DP ) & + * ( sin( zz(iz) ) & + + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & + ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = ( kx(mx) + s_hat * zz(iz) * ky(my) )**2 + ky(my)**2 + end do + end do + +!!! for s-alpha !!! <--- the current version is the same as "analytic" + else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then + + dpara(iz) = dz* q_0 * r_major + + kkx = -r_major * (q_0/q_bar) & + * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz + kky = r_major * (q_bar/q_0) & + * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) & + * (q_bar/q_0) + end do + + end do ! im loop ends + + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = ( kx(mx) + ( s_hat * zz(iz) - alpha_MHD*sin(zz(iz)) ) & + * ky(my) )**2 + ky(my)**2 ! with Shafranov shift + end do + end do + +!!! for circular MHD equilibrium !!! + else if( trim(equib_type) == "circ-MHD" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im)= & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im)= & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & + + 2._DP*kx(mx)*ky(my)*gg(1,2) & + + (ky(my)**2)*gg(2,2) + end do + end do + +! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) + else if( trim(equib_type) == "vmec" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & + - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term + * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & + + 2._DP*kx(mx)*ky(my)*gg(1,2) & + + (ky(my)**2)*gg(2,2) + end do + end do + + else if( trim(equib_type) == "eqdsk" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & + - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term + * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & + + 2._DP*kx(mx)*ky(my)*gg(1,2) & + + (ky(my)**2)*gg(2,2) + end do + end do + + else + + write( olog, * ) " # wrong choice of the equilibrium " + call flush(olog) + call MPI_Finalize(ierr_mpi) + stop + + end if + + + do im = 0, nm + do my = ist_y, iend_y + do mx = -nx, nx + kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & + * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) + call math_j0( kmo, j0(mx,my,iz,im) ) + call math_j1( kmo, j1(mx,my,iz,im) ) + call math_j2( kmo, j2(mx,my,iz,im) ) + end do + end do + end do + + + do my = ist_y, iend_y + do mx = -nx, nx + bb = ksq(mx,my,iz) / omg(iz)**2 & + * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) + call math_g0( bb, g0(mx,my,iz) ) + end do + end do + + end do ! iz loop ends + + cfsrf = 0._DP + cfsrf_l = 0._DP + do iz = -nz, nz-1 + cfsrf_l = cfsrf_l + rootg(iz) + ! normalization coefficient for + ! the surface average + end do + call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & + MPI_SUM, zsp_comm_world, ierr_mpi ) + + if ( vel_rank == 0 ) then + do iz = -nz, nz-1 + dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) + end do + end if + call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & + vel_comm_world, ierr_mpi ) + + do im = 0, nm + do iv = 1, 2*nv + do iz = -nz, nz-1 + fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & + / sqrt( twopi**3 ) + end do + end do + end do + + allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) + +! --- GK polarization factor for efield calculation + fct_poisson(:,:,:) = 0._DP + fct_e_energy(:,:,:) = 0._DP + + ww(:,:,:) = 0._DP + do iz = -nz, nz-1 + do my = ist_y, iend_y + do mx = -nx, nx + + if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode + + fct_poisson(mx,my,iz) = 0._DP + fct_e_energy(mx,my,iz) = 0._DP + + else + + ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) + do is = 0, ns-1 + bb = ksq(mx,my,iz) / omg(iz)**2 & + * tau(is)*Anum(is)/(Znum(is)**2) + call math_g0( bb, gg0 ) + ww(mx,my,iz) = ww(mx,my,iz) & + + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) + end do + fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) + fct_e_energy(mx,my,iz) = ww(mx,my,iz) + + end if + + end do + end do + end do + + +! --- ZF-factor for adiabatic model + if ( ns == 1 ) then + + ww(:,:,:) = 0._DP + do iz = -nz, nz-1 + my = 0 + do mx = -nx, nx + ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & + / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) + end do + end do + + call intgrl_fsrf ( ww, fctgt ) + + if ( rankw == 0 ) then + fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) + ! g0(0,0,iz) has no z dependence + endif + + endif + + deallocate( ww ) + + allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) + allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) + wf(:,:,:,:,:) = ( 0._DP, 0._DP ) + nw(:,:,:) = ( 0._DP, 0._DP ) + +! --- GK polarization factor for mfield calculation + fct_ampere(:,:,:) = 0._DP + fct_m_energy(:,:,:) = 0._DP + + if ( beta .ne. 0._DP ) then + + do im = 0, nm + do iv = 1, 2*nv + do iz = -nz, nz-1 + do my = ist_y, iend_y + do mx = -nx, nx + wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & + * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) + end do + end do + end do + end do + end do + + call intgrl_v0_moment_ms ( wf, nw ) + + do iz = -nz, nz-1 + do my = ist_y, iend_y + do mx = -nx, nx + fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) + fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta + end do + end do + end do + + if ( rankw == 0 ) then + do iz = -nz, nz-1 + fct_ampere(0,0,iz) = 0._DP + fct_m_energy(0,0,iz) = 0._DP + end do + end if + + end if + + deallocate( wf ) + deallocate( nw ) + + END SUBROUTINE geom_set_operators_old + + +!-------------------------------------- + SUBROUTINE geom_set_operators +!-------------------------------------- + implicit none + real(kind=DP) :: wzz ! The rotating flux tube coordinate (= z'') + real(kind=DP) :: zz_lab ! The flux-coordinate theta in the lab frame (= z''+t*gamma_e/s_hat) + real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy + real(kind=DP) :: bb, kmo + real(kind=DP) :: gg0 + + real(kind=DP) :: cfsrf_l + real(kind=DP), dimension(1:3,1:3) :: gg + complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf + complex(kind=DP), dimension(:,:,:), allocatable :: nw + real(kind=DP), dimension(:,:,:), allocatable :: ww + + integer :: mx, my, iz, iv, im, is + + do iz = -nz, nz-1 + + wzz = zz(iz) + zz_lab = mtr_local%zz_labframe(iz) + omg(iz) = mtr_local%omg(iz) + domgdx = mtr_local%domgdx(iz) + domgdy = mtr_local%domgdy(iz) + domgdz = mtr_local%domgdz(iz) + gg(1,1) = mtr_local%gxx(iz) + gg(1,2) = mtr_local%gxy(iz) + gg(1,3) = mtr_local%gxz(iz) + gg(2,2) = mtr_local%gyy(iz) + gg(2,3) = mtr_local%gyz(iz) + gg(3,3) = mtr_local%gzz(iz) + rootg(iz) = mtr_local%rootg_xyz(iz) + gg(2,1) = gg(1,2) + gg(3,1) = gg(1,3) + gg(3,2) = gg(2,3) + +!!! for slab model + if ( trim(equib_type) == "slab") then + + dpara(iz) = dz * q_0 * r_major + + do im = 0, nm + vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) + mir(iz,im) = 0._DP + do iv = 1, 2*nv + vdx(iz,iv,im) = 0._DP + vdy(iz,iv,im) = 0._DP + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 + end do + end do + +!!! for the concentric and large-aspect-ratio model !!! + else if( trim(equib_type) == "analytic" ) then + + dpara(iz) = dz * q_0 * r_major + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & + * ( sin(zz_lab) & + + eps_hor * lmmq * sin( lmmq * zz_lab - malpha ) & + + eps_mor * lmmqm1 * sin( lmmqm1 * zz_lab - malpha ) & + + eps_por * lmmqp1 * sin( lmmqp1 * zz_lab - malpha ) ) + + do iv = 1, 2*nv + vdx(iz,iv,im)= & + - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & + * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz_lab ) & + + rdeps2_10 * cos( lmmq * zz_lab - malpha ) & + + rdeps1_10 * cos( lmmqm1 * zz_lab - malpha ) & + + rdeps3_10 * cos( lmmqp1 * zz_lab - malpha ) ) & + + ( 1._DP + s_hat * wzz * 0._DP ) & + * ( sin( zz_lab ) & + + eps_hor * lprd * sin( lmmq * zz_lab - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * zz_lab - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * zz_lab - malpha ) ) & + ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im)= & + - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & + * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz_lab ) & + + rdeps2_10 * cos( lmmq * zz_lab - malpha ) & + + rdeps1_10 * cos( lmmqm1 * zz_lab - malpha ) & + + rdeps3_10 * cos( lmmqp1 * zz_lab - malpha ) ) & + + ( 0._DP + s_hat * wzz * 1._DP ) & + * ( sin( zz_lab ) & + + eps_hor * lprd * sin( lmmq * zz_lab - malpha ) & + + eps_mor * lprdm1 * sin( lmmqm1 * zz_lab - malpha ) & + + eps_por * lprdp1 * sin( lmmqp1 * zz_lab - malpha ) ) & + ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = ( kx(mx) + s_hat * wzz * ky(my) )**2 + ky(my)**2 + end do + end do + +!!! for s-alpha !!! <--- the current version is the same as "analytic" + else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then + + dpara(iz) = dz* q_0 * r_major + + kkx = -r_major * (q_0/q_bar) & + * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz + kky = r_major * (q_bar/q_0) & + * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) & + * (q_bar/q_0) + end do + + end do ! im loop ends + + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = ( kx(mx) + ( s_hat * wzz - alpha_MHD*sin(zz_lab) ) & + * ky(my) )**2 + ky(my)**2 ! with Shafranov shift + end do + end do + +!!! for circular MHD equilibrium !!! + else if( trim(equib_type) == "circ-MHD" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im)= & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im)= & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & + + 2._DP*kx(mx)*ky(my)*gg(1,2) & + + (ky(my)**2)*gg(2,2) + end do + end do + +! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) + else if( trim(equib_type) == "vmec" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & + - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term + * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & + + 2._DP*kx(mx)*ky(my)*gg(1,2) & + + (ky(my)**2)*gg(2,2) + end do + end do + + else if( trim(equib_type) == "eqdsk" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kkx & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & + - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term + * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + + vsy(iz,iv,im) = & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & + + 2._DP*kx(mx)*ky(my)*gg(1,2) & + + (ky(my)**2)*gg(2,2) + end do + end do + + else + + write( olog, * ) " # wrong choice of the equilibrium " + call flush(olog) + call MPI_Finalize(ierr_mpi) + stop + + end if + + + do im = 0, nm + do my = ist_y, iend_y + do mx = -nx, nx + kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & + * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) + call math_j0( kmo, j0(mx,my,iz,im) ) + call math_j1( kmo, j1(mx,my,iz,im) ) + call math_j2( kmo, j2(mx,my,iz,im) ) + end do + end do + end do + + + do my = ist_y, iend_y + do mx = -nx, nx + bb = ksq(mx,my,iz) / omg(iz)**2 & + * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) + call math_g0( bb, g0(mx,my,iz) ) + end do + end do + + end do ! iz loop ends + + cfsrf = 0._DP + cfsrf_l = 0._DP + do iz = -nz, nz-1 + cfsrf_l = cfsrf_l + rootg(iz) + ! normalization coefficient for + ! the surface average + end do + call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & + MPI_SUM, zsp_comm_world, ierr_mpi ) + + if ( vel_rank == 0 ) then + do iz = -nz, nz-1 + dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) + end do + end if + call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & + vel_comm_world, ierr_mpi ) + + do im = 0, nm + do iv = 1, 2*nv + do iz = -nz, nz-1 + fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & + / sqrt( twopi**3 ) + end do + end do + end do + + allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) + +! --- GK polarization factor for efield calculation + fct_poisson(:,:,:) = 0._DP + fct_e_energy(:,:,:) = 0._DP + + ww(:,:,:) = 0._DP + do iz = -nz, nz-1 + do my = ist_y, iend_y + do mx = -nx, nx + + if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode + + fct_poisson(mx,my,iz) = 0._DP + fct_e_energy(mx,my,iz) = 0._DP + + else + + ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) + do is = 0, ns-1 + bb = ksq(mx,my,iz) / omg(iz)**2 & + * tau(is)*Anum(is)/(Znum(is)**2) + call math_g0( bb, gg0 ) + ww(mx,my,iz) = ww(mx,my,iz) & + + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) + end do + fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) + fct_e_energy(mx,my,iz) = ww(mx,my,iz) + + end if + + end do + end do + end do + + +! --- ZF-factor for adiabatic model + if ( ns == 1 ) then + + ww(:,:,:) = 0._DP + do iz = -nz, nz-1 + my = 0 + do mx = -nx, nx + ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & + / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) + end do + end do + + call intgrl_fsrf ( ww, fctgt ) + + if ( rankw == 0 ) then + fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) + ! g0(0,0,iz) has no z dependence + endif + + endif + + deallocate( ww ) + + allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) + allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) + wf(:,:,:,:,:) = ( 0._DP, 0._DP ) + nw(:,:,:) = ( 0._DP, 0._DP ) + +! --- GK polarization factor for mfield calculation + fct_ampere(:,:,:) = 0._DP + fct_m_energy(:,:,:) = 0._DP + + if ( beta .ne. 0._DP ) then + + do im = 0, nm + do iv = 1, 2*nv + do iz = -nz, nz-1 + do my = ist_y, iend_y + do mx = -nx, nx + wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & + * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) + end do + end do + end do + end do + end do + + call intgrl_v0_moment_ms ( wf, nw ) + + do iz = -nz, nz-1 + do my = ist_y, iend_y + do mx = -nx, nx + fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) + fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta + end do + end do + end do + + if ( rankw == 0 ) then + do iz = -nz, nz-1 + fct_ampere(0,0,iz) = 0._DP + fct_m_energy(0,0,iz) = 0._DP + end do + end if + + end if + + deallocate( wf ) + deallocate( nw ) + + END SUBROUTINE geom_set_operators + +!-------------------------------------- + SUBROUTINE geom_reset_time(time_shearflow) +!-------------------------------------- + implicit none + real(kind=DP), intent(in) :: time_shearflow + call mtr_local%init(mtr_fourier, time_shearflow) + call geom_set_operators + !NOTE: colliimp_set_param in GKV_colliimp should also be updated. + END SUBROUTINE geom_reset_time + +!-------------------------------------- + SUBROUTINE geom_increment_time(dt_shearflow) +!-------------------------------------- + implicit none + real(kind=DP), intent(in) :: dt_shearflow + call mtr_local%update(mtr_fourier, dt_shearflow) + call geom_set_operators + !NOTE: colliimp_set_param in GKV_colliimp should also be updated. + END SUBROUTINE geom_increment_time + + +!-------------------------------------- + SUBROUTINE metric_global_init(self, iz, wzz, theta, gomg, & + gdomgdx, gdomgdy, gdomgdz, ggxx, ggxy, & + ggxz, ggyy, ggyz, ggzz, grootg_xyz, & + gdomgdr, gdomgdt, gdomgdq, ggrr, ggrt, & + ggrq, ggtt, ggtq, ggqq, grootg_rtq) +!-------------------------------------- + implicit none + class(metric_global), intent(inout) :: self + integer, intent(in) :: iz + real(kind=DP), intent(in) :: wzz, theta, gomg + real(kind=DP), intent(in) :: gdomgdx, gdomgdy, gdomgdz, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz, grootg_xyz + real(kind=DP), intent(in) :: gdomgdr, gdomgdt, gdomgdq, & + ggrr, ggrt, ggrq, ggtt, ggtq, ggqq, grootg_rtq + + self%zz(iz) = wzz + self%theta(iz) = theta + self%omg(iz) = gomg + self%domgdx(iz) = gdomgdx + self%domgdy(iz) = gdomgdy + self%domgdz(iz) = gdomgdz + self%gxx(iz) = ggxx + self%gxy(iz) = ggxy + self%gxz(iz) = ggxz + self%gyy(iz) = ggyy + self%gyz(iz) = ggyz + self%gzz(iz) = ggzz + self%rootg_xyz(iz) = grootg_xyz + self%domgdr(iz) = gdomgdr + self%domgdt(iz) = gdomgdt + self%domgdq(iz) = gdomgdq + self%grr(iz) = ggrr + self%grt(iz) = ggrt + self%grq(iz) = ggrq + self%gtt(iz) = ggtt + self%gtq(iz) = ggtq + self%gqq(iz) = ggqq + self%rootg_rtq(iz) = grootg_rtq + + END SUBROUTINE metric_global_init + + +!-------------------------------------- + SUBROUTINE metric_global_xyz2rtq(self) +!-------------------------------------- + implicit none + class(metric_global), intent(inout) :: self + real(kind=DP) :: wzz + real(kind=DP) :: gdomgdx, gdomgdy, gdomgdz, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz, grootg_xyz + real(kind=DP) :: gdomgdr, gdomgdt, gdomgdq, & + ggrr, ggrt, ggrq, ggtt, ggtq, ggqq, grootg_rtq + integer :: iz + + do iz = -global_nz, global_nz-1 + ! load (x,y,z) + wzz = self%zz(iz) + gdomgdx = self%domgdx(iz) + gdomgdy = self%domgdy(iz) + gdomgdz = self%domgdz(iz) + ggxx = self%gxx(iz) + ggxy = self%gxy(iz) + ggxz = self%gxz(iz) + ggyy = self%gyy(iz) + ggyz = self%gyz(iz) + ggzz = self%gzz(iz) + grootg_xyz = self%rootg_xyz(iz) + + ! translate (x,y,z)->(r,t,q)=(rho,theta,zeta) + ! NOTE: cx*rho0/(cy*q_0=1) is used. + gdomgdr = cx*gdomgdx + s_hat*wzz*gdomgdy + gdomgdt = gdomgdz + cy*q_0*gdomgdy + gdomgdq = - cy*gdomgdy + ggrr = ggxx/cx**2 + ggrt = ggxz/cx + ggrq = (s_hat*wzz*ggxx-ggxy)/(cx*cy) + q_0*ggxz/cx + ggtt = ggzz + ggtq = (s_hat*wzz*ggxz-ggyz)/cy + q_0*ggzz + ggqq = (s_hat*wzz/cy)**2*ggxx - 2._DP*(s_hat*wzz/cy**2)*ggxy & + + 2._DP*(q_0*s_hat*wzz/cy)*ggxz + ggyy/cy**2 & + - 2._DP*(q_0/cy)*ggyz + q_0**2*ggzz + grootg_rtq = cx*cy*grootg_xyz + + ! store (r,t,q) + self%domgdr(iz) = gdomgdr + self%domgdt(iz) = gdomgdt + self%domgdq(iz) = gdomgdq + self%grr(iz) = ggrr + self%grt(iz) = ggrt + self%grq(iz) = ggrq + self%gtt(iz) = ggtt + self%gtq(iz) = ggtq + self%gqq(iz) = ggqq + self%rootg_rtq(iz) = grootg_rtq + end do + + END SUBROUTINE metric_global_xyz2rtq + + +!-------------------------------------- + SUBROUTINE metric_global_rtq2xyz(self) +!-------------------------------------- + implicit none + class(metric_global), intent(inout) :: self + real(kind=DP) :: wzz + real(kind=DP) :: gdomgdx, gdomgdy, gdomgdz, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz, grootg_xyz + real(kind=DP) :: gdomgdr, gdomgdt, gdomgdq, & + ggrr, ggrt, ggrq, ggtt, ggtq, ggqq, grootg_rtq + integer :: iz + + do iz = -global_nz, global_nz-1 + ! load (r,t,q)=(rho,theta,zeta) + wzz = self%zz(iz) + gdomgdr = self%domgdr(iz) + gdomgdt = self%domgdt(iz) + gdomgdq = self%domgdq(iz) + ggrr = self%grr(iz) + ggrt = self%grt(iz) + ggrq = self%grq(iz) + ggtt = self%gtt(iz) + ggtq = self%gtq(iz) + ggqq = self%gqq(iz) + grootg_rtq = self%rootg_rtq(iz) + + ! translate (r,t,q)->(x,y,z) + ! NOTE: cx*rho0/(cy*q_0=1) is used. + gdomgdx = gdomgdr/cx + s_hat*wzz*gdomgdq/cy + gdomgdy = - gdomgdq/cy + gdomgdz = gdomgdt + q_0*gdomgdq + ggxx = cx**2*ggrr + ggxy = cx**2*s_hat*wzz*ggrr + cx*cy*(q_0*ggrt - ggrq) + ggxz = cx*ggrt + ggyy = (cx*s_hat*wzz)**2*ggrr + 2._DP*cx*cy*s_hat*wzz*(q_0*ggrt-ggrq) & + + (cy*q_0)**2*ggtt - 2._DP*cy**2*q_0*ggtq + cy**2*ggqq + ggyz = cx*s_hat*wzz*ggrt + cy*q_0*ggtt - cy*ggtq + ggzz = ggtt + grootg_xyz = grootg_rtq/(cx*cy) + + ! store (x,y,z) + self%domgdx(iz) = gdomgdx + self%domgdy(iz) = gdomgdy + self%domgdz(iz) = gdomgdz + self%gxx(iz) = ggxx + self%gxy(iz) = ggxy + self%gxz(iz) = ggxz + self%gyy(iz) = ggyy + self%gyz(iz) = ggyz + self%gzz(iz) = ggzz + self%rootg_xyz(iz) = grootg_xyz + end do + + END SUBROUTINE metric_global_rtq2xyz + + +!-------------------------------------- + SUBROUTINE metric_fourier_init(self) +!-------------------------------------- + implicit none + class(metric_fourier), intent(inout) :: self + real(kind=DP) :: kzmin + integer :: iz + + kzmin = 2._DP * pi / (2._DP * lz) + do iz = -global_nz, global_nz-1 + self%kz(iz) = iz * kzmin + end do + + END SUBROUTINE metric_fourier_init + + +!-------------------------------------- + SUBROUTINE forward_dft_globalz(zz_global,kz,fz,fk) +!-------------------------------------- + implicit none + real(kind=DP), intent(in), & + dimension(-global_nz:global_nz-1) :: zz_global, kz, fz + complex(kind=DP), intent(out), & + dimension(-global_nz:global_nz-1) :: fk + integer :: iz, mz + + fk(:) = (0._DP, 0._DP) + do mz = -global_nz, global_nz-1 + do iz = -global_nz, global_nz-1 + fk(mz) = fk(mz) + fz(iz)*exp(-ui*kz(mz)*zz_global(iz))*dz/(2._DP*lz) + end do + end do + + END SUBROUTINE forward_dft_globalz + + +!!-------------------------------------- +! SUBROUTINE backward_dft_globalz(zz_global,kz,fk,fz) +!!-------------------------------------- +! implicit none +! real(kind=DP), intent(in), & +! dimension(-global_nz:global_nz-1) :: zz_global, kz +! complex(kind=DP), intent(in), & +! dimension(-global_nz:global_nz-1) :: fk +! real(kind=DP), intent(out), & +! dimension(-global_nz:global_nz-1) :: fz +! integer :: iz, mz +! +! fz(:) = 0._DP +! do iz = -global_nz, global_nz-1 +! do mz = -global_nz, global_nz-1 +! fz(iz) = fz(iz) + real(fk(mz)*exp(ui*kz(mz)*zz_global(iz)), kind=DP) +! end do +! end do +! +! END SUBROUTINE backward_dft_globalz + + +!-------------------------------------- + SUBROUTINE backward_dft_localz(zz_local,kz,fk,fz) +!-------------------------------------- + implicit none + real(kind=DP), intent(in), & + dimension(-nz:nz-1) :: zz_local + real(kind=DP), intent(in), & + dimension(-global_nz:global_nz-1) :: kz + complex(kind=DP), intent(in), & + dimension(-global_nz:global_nz-1) :: fk + real(kind=DP), intent(out), & + dimension(-nz:nz-1) :: fz + integer :: iz, mz + + fz(:) = 0._DP + do iz = -nz, nz-1 + do mz = -global_nz, global_nz-1 + fz(iz) = fz(iz) + real(fk(mz)*exp(ui*kz(mz)*zz_local(iz)), kind=DP) + end do + end do + + END SUBROUTINE backward_dft_localz + + +!-------------------------------------- + SUBROUTINE metric_fourier_dft_rtq2coef(self, mtr_g) +!-------------------------------------- + implicit none + class(metric_fourier), intent(inout) :: self + class(metric_global), intent(in) :: mtr_g + real(kind=DP), dimension(-global_nz:global_nz-1) :: theta_tilde + + ! theta = zz + theta_tilde(zz), theta_tilde is a periodic function. + if (trim(equib_type) == "vmec") then + theta_tilde = mtr_g%theta - q_0 * mtr_g%zz ! Axisymmetric toroidal angle phi_ax + else + theta_tilde = mtr_g%theta - mtr_g%zz + end if + call forward_dft_globalz(mtr_g%zz, self%kz, theta_tilde, self%theta_tilde) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%omg , self%omg ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%domgdr , self%domgdr ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%domgdt , self%domgdt ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%domgdq , self%domgdq ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%grr , self%grr ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%grt , self%grt ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%grq , self%grq ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%gtt , self%gtt ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%gtq , self%gtq ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%gqq , self%gqq ) + call forward_dft_globalz(mtr_g%zz, self%kz, mtr_g%rootg_rtq, self%rootg_rtq) + ! NOTE: + ! Arguments are (zz_global(in),kz_global(in),omg_global(in),coef_global(out)) + + END SUBROUTINE metric_fourier_dft_rtq2coef + + +!-------------------------------------- + SUBROUTINE metric_local_dft_coef2rtq(self, mtr_f) +!-------------------------------------- + implicit none + class(metric_local), intent(inout) :: self + class(metric_fourier), intent(in) :: mtr_f + real(kind=DP), dimension(-nz:nz-1) :: theta_tilde + + ! theta = zz + theta_tilde(zz), theta_tilde is a periodic function. + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%theta_tilde, theta_tilde ) + if (trim(equib_type) == "vmec") then + self%theta = q_0 * self%zz_labframe + theta_tilde ! Axisymmetric toroidal angle phi_ax = q_0*zz + phi_tilde(zz) + else + self%theta = self%zz_labframe + theta_tilde + end if + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%omg , self%omg ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%domgdr , self%domgdr ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%domgdt , self%domgdt ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%domgdq , self%domgdq ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%grr , self%grr ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%grt , self%grt ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%grq , self%grq ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%gtt , self%gtt ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%gtq , self%gtq ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%gqq , self%gqq ) + call backward_dft_localz(self%zz_labframe, mtr_f%kz, mtr_f%rootg_rtq, self%rootg_rtq) + ! NOTE: + ! Arguments are (zz_local(in),kz_global(in), coef_global(in), omg_local(out)). + ! Fourier coefficients have been evaluated in the lab frame at t=0. + ! self%zz_labframe (= z''+t*gamma_e/s_hat) is the time-dependent flux-coordinate theta in the lab frame. + + END SUBROUTINE metric_local_dft_coef2rtq + + +!-------------------------------------- + SUBROUTINE metric_local_rtq2xyz(self) +!-------------------------------------- + implicit none + class(metric_local), intent(inout) :: self + real(kind=DP) :: wzz + real(kind=DP) :: gdomgdx, gdomgdy, gdomgdz, & + ggxx, ggxy, ggxz, ggyy, ggyz, ggzz, grootg_xyz + real(kind=DP) :: gdomgdr, gdomgdt, gdomgdq, & + ggrr, ggrt, ggrq, ggtt, ggtq, ggqq, grootg_rtq + integer :: iz + + do iz = -nz, nz-1 + ! load (r,t,q)=(rho,theta,zeta) + wzz = self%zz(iz) + gdomgdr = self%domgdr(iz) + gdomgdt = self%domgdt(iz) + gdomgdq = self%domgdq(iz) + ggrr = self%grr(iz) + ggrt = self%grt(iz) + ggrq = self%grq(iz) + ggtt = self%gtt(iz) + ggtq = self%gtq(iz) + ggqq = self%gqq(iz) + grootg_rtq = self%rootg_rtq(iz) + + ! translate (r,t,q)->(x,y,z) + ! NOTE: cx*rho0/(cy*q_0=1) is used. + gdomgdx = gdomgdr/cx + s_hat*wzz*gdomgdq/cy + gdomgdy = - gdomgdq/cy + gdomgdz = gdomgdt + q_0*gdomgdq + ggxx = cx**2*ggrr + ggxy = cx**2*s_hat*wzz*ggrr + cx*cy*(q_0*ggrt - ggrq) + ggxz = cx*ggrt + ggyy = (cx*s_hat*wzz)**2*ggrr + 2._DP*cx*cy*s_hat*wzz*(q_0*ggrt-ggrq) & + + (cy*q_0)**2*ggtt - 2._DP*cy**2*q_0*ggtq + cy**2*ggqq + ggyz = cx*s_hat*wzz*ggrt + cy*q_0*ggtt - cy*ggtq + ggzz = ggtt + grootg_xyz = grootg_rtq/(cx*cy) + + ! store (x,y,z) + self%domgdx(iz) = gdomgdx + self%domgdy(iz) = gdomgdy + self%domgdz(iz) = gdomgdz + self%gxx(iz) = ggxx + self%gxy(iz) = ggxy + self%gxz(iz) = ggxz + self%gyy(iz) = ggyy + self%gyz(iz) = ggyz + self%gzz(iz) = ggzz + self%rootg_xyz(iz) = grootg_xyz + end do + + END SUBROUTINE metric_local_rtq2xyz + + +!-------------------------------------- + SUBROUTINE metric_local_copy_global(self, mtr_g) +!-------------------------------------- + implicit none + class(metric_local), intent(inout) :: self + class(metric_global), intent(in) :: mtr_g + integer :: iz, giz + + do iz = -nz, nz-1 + giz = iz - global_nz + 2*nz * rankz + nz + self%zz(iz) = mtr_global%zz(giz) + self%theta(iz) = mtr_global%theta(giz) + self%omg(iz) = mtr_global%omg(giz) + self%domgdx(iz) = mtr_global%domgdx(giz) + self%domgdy(iz) = mtr_global%domgdy(giz) + self%domgdz(iz) = mtr_global%domgdz(giz) + self%gxx(iz) = mtr_global%gxx(giz) + self%gxy(iz) = mtr_global%gxy(giz) + self%gxz(iz) = mtr_global%gxz(giz) + self%gyy(iz) = mtr_global%gyy(giz) + self%gyz(iz) = mtr_global%gyz(giz) + self%gzz(iz) = mtr_global%gzz(giz) + self%rootg_xyz(iz) = mtr_global%rootg_xyz(giz) + end do + + END SUBROUTINE metric_local_copy_global + + +!-------------------------------------- + SUBROUTINE metric_local_init(self, mtr_f, time_shearflow) +!-------------------------------------- + implicit none + class(metric_local), intent(inout) :: self + class(metric_fourier), intent(in) :: mtr_f + real(kind=DP), intent(in) :: time_shearflow + + self%zz(:) = zz(:) + self%zz_labframe(:) = zz(:) + time_shearflow * gamma_e / s_hat + call self%dft_coef2rtq(mtr_f) + call self%rtq2xyz + + END SUBROUTINE metric_local_init + + +!-------------------------------------- + SUBROUTINE metric_local_update(self, mtr_f, dt_shearflow) +!-------------------------------------- + implicit none + class(metric_local), intent(inout) :: self + class(metric_fourier), intent(in) :: mtr_f + real(kind=DP), intent(in) :: dt_shearflow + + self%zz_labframe(:) = self%zz_labframe(:) + dt_shearflow * gamma_e / s_hat + call self%dft_coef2rtq(mtr_f) + call self%rtq2xyz + + END SUBROUTINE metric_local_update + + +END MODULE GKV_geom diff --git a/src/gkvp_header.f90 b/src/gkvp_header.f90 index ecf41e9..f19f842 100644 --- a/src/gkvp_header.f90 +++ b/src/gkvp_header.f90 @@ -38,9 +38,9 @@ MODULE GKV_header ! in x, y,z,v,m (0:2*nxw-1, 0:2*nyw-1,-global_nz:global_nz-1,1:2*global_nv,0:global_nm) ! in kx,ky,z,v,m ( -nx:nx,0:global_ny,-global_nz:global_nz-1,1:2*global_nv,0:global_nm) - integer, parameter :: nxw = 2, nyw = 20 - integer, parameter :: nx = 0, global_ny = 12 ! 2/3 de-aliasing rule - integer, parameter :: global_nz = 48, global_nv = 24, global_nm = 15 + integer, parameter :: nxw = 20, nyw = 20 + integer, parameter :: nx = 4, global_ny = 1 ! 2/3 de-aliasing rule + integer, parameter :: global_nz = 12, global_nv = 24, global_nm = 7 integer, parameter :: nzb = 2, & ! the number of ghost grids in z nvb = 2 ! the number of ghost grids in v and m @@ -49,7 +49,7 @@ MODULE GKV_header ! Data distribution for MPI !-------------------------------------- - integer, parameter :: nprocw = 2, nprocz = 4, nprocv = 2, nprocm = 2, nprocs = 1 + integer, parameter :: nprocw = 1, nprocz = 2, nprocv = 4, nprocm = 2, nprocs = 1 !-------------------------------------- ! Parameters for variable sizes @@ -169,7 +169,7 @@ MODULE GKV_header tau, & ! T-ratio dns1 ! initial perturbation amp. real(kind=DP) :: dv, cfsrf, lambda_i, q_0, q_bar, beta, tau_ad, vmax - real(kind=DP) :: mach, uprime, gamma_e, kxmin_g, kymin_g, tlim_exb + real(kind=DP) :: mach, uprime, gamma_e, kxmin_g, kymin_g, tlim_exb, s_hat_g real(kind=DP) :: Nref, Lref, Tref, Zeff integer :: iFLR, icheck, ibprime, nx0 real(kind=DP) :: baxfactor @@ -201,6 +201,11 @@ MODULE GKV_header character(15) :: equib_type ! "analytic", "s-alpha", "s-alpha-shift", ! "circ-MHD", "vmec", "eqdsk", "slab" + !character(15) :: flag_shearflow = "remap" ! Wavevector remap method + ! ! with nearest grid approximation + ! ! (Discontinuous in time) + character(15) :: flag_shearflow = "rotating" ! Rotating flux tube model + ! --- unit numbers for I/O integer, parameter :: inml = 5, & olog = 10, & diff --git a/src/gkvp_main.f90 b/src/gkvp_main.f90 index 04e5db3..bfafc50 100644 --- a/src/gkvp_main.f90 +++ b/src/gkvp_main.f90 @@ -136,7 +136,7 @@ PROGRAM GKV_main end if - if (gamma_e /= 0._DP) then + if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "remap") then call shearflow_kxmap( time, ff, phi, Al, hh ) if (time > tlim_exb - eps .AND. cflg == 0 ) then write( olog, * ) "" diff --git a/src/gkvp_set.f90 b/src/gkvp_set.f90 index 37259b9..6b3a2df 100644 --- a/src/gkvp_set.f90 +++ b/src/gkvp_set.f90 @@ -21,24 +21,20 @@ MODULE GKV_set use GKV_header use GKV_mpienv - use GKV_math, only: math_j0, math_j1, math_j2, math_g0, math_random - use GKV_intgrl, only: intgrl_fsrf, intgrl_v0_moment_ms + use GKV_math, only: math_random use GKV_fld, only: fld_esfield, fld_emfield_ff, fld_ff2hh use GKV_bndry, only: bndry_zvm_bound_f use GKV_advnc, only: caldlt_rev use GKV_dtc, only: dtc_init -! for vmec equilibrium -! use GKV_vmecin, only: vmecin_fileopen, vmecin_coeff, vmecin_read -! for vmec equilibrium w/ Booz_xform by M. Nakata & M. Nunami (Aug. 2016) - use GKV_vmecbzx, only: vmecbzx_boozx_read, vmecbzx_boozx_coeff -! for tokamak(eqdsk) equilibrium - use GKV_igs, only: igs_read, igs_coeff use GKV_colli, only: colli_set_param use GKV_colliimp, only: colliimp_set_param use GKV_tips, only: tips_reality !fj start 202010 use GKV_fileio !fj end 202010 + use GKV_geom, only : geom_read_nml, geom_init_kxkyzvm, & + geom_init_metric, geom_set_operators, & + geom_reset_time implicit none @@ -46,7 +42,6 @@ MODULE GKV_set public set_init, set_close - CONTAINS !-------------------------------------- @@ -394,99 +389,10 @@ END SUBROUTINE set_param SUBROUTINE set_cnfig !-------------------------------------- - real(kind=DP) :: s_hat - - real(kind=DP) :: eps_r - - real(kind=DP) :: rdeps00, eps_hor, lprd, mprd, lmmq, malpha - real(kind=DP) :: eps_mor, eps_por, lprdm1, lprdp1, lmmqm1, lmmqp1 - real(kind=DP) :: eps_rnew, rdeps1_0, rdeps1_10, rdeps2_10, rdeps3_10 - -! for s-alpha model with Shafranov shift - real(kind=DP) :: p_total, dp_totaldx, beta_total, alpha_MHD - -! for circular MHD - real(kind=DP), dimension(1:3,1:3) :: gg - real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy - - -!! for vmec equilibrium -! real(kind=DP) :: rho2R_0, q_input, theta -! real(kind=DP) :: r_0 -! real(kind=DP) :: gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & -! gupss, guptt, gupzz, gupst, gupsz, guptz, & -! babs, Bs , Bth , Bzt , dBds, dBdt, dBdz, & -! dBdt_mir, vmec_rootg, rootgft, rootgbz - real(kind=DP) :: theta - - - real(kind=DP) :: lx, ly, lz, kxmin, kymin, dz, mmax, dm, del_c - real(kind=DP) :: lz_l, z0, z0_l - integer :: n_tht, m_j - - real(kind=DP) :: gg0 - - real(kind=DP) :: bb, kmo - real(kind=DP) :: cfsrf_l - - integer :: global_iv, global_im - integer :: mx, my, iz, iv, im, is, is1, is2, ierr_mpi - - - complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf - complex(kind=DP), dimension(:,:,:), allocatable :: nw - real(kind=DP), dimension(:,:,:), allocatable :: ww - -! real(kind=DP) :: rad_a, r_minor, eps_b, rho_unit, r_a -! real(kind=DP) :: R0_unit, r_edge, b0b00, alpha_fix - - real(kind=DP), dimension(0:ns-1) :: eta real(kind=DP), dimension(0:ns-1,0:ns-1) :: nust - real(kind=DP) :: r_major + real(kind=DP) :: lx, ly, eps_r + integer :: is1, is2 - real(kind=DP) :: s_input, s_0 ! radial label of fluxtube center - integer :: mc_type ! 0:Axisym., 1:Boozer, 2:Hamada - integer :: q_type ! 0:use q and s_hat value in confp, 1:calclated by IGS - integer :: isw, nss, ntheta, nzeta - real(kind=DP) :: phi_ax ! axisymetric toroidal angle - - integer, parameter :: num_omtr = 13 - real(kind=DP) :: metric_l(1:num_omtr,-nz:nz-1), metric_g(1:num_omtr,-global_nz:global_nz-1) - - - - - namelist /physp/ R0_Ln, & ! R0/Lns - R0_Lt, & ! R0/Lts - nu, & ! factor for collision freq. in LB model - Anum, & ! mass number - Znum, & ! charge number - fcs, & ! charge-density fraction - sgn, & ! signs of charge - tau, & ! T-ratio Ts/T0, T0=reference ion temp. of ranks=1 - dns1, & ! initial perturbation amplitude - tau_ad, & ! Ti/Te for ITG-ae, Te/Ti for ETG-ai - lambda_i, & ! (Debye/rho_tp)^2 - beta, & ! mu0*ni*Ti/B^2 - ibprime, & ! flag for finite beta-prime effect on kvd - vmax, & ! maximum v_para in unit of v_ts - nx0 ! mode number for the initial perturbation - - namelist /rotat/ mach, uprime, gamma_e - - namelist /nperi/ n_tht, kymin, m_j, del_c - namelist /confp/ eps_r, eps_rnew, & - q_0, s_hat, & - lprd, mprd, eps_hor, eps_mor, eps_por, & - rdeps00, rdeps1_0, rdeps1_10, & - rdeps2_10, rdeps3_10, malpha -! namelist /vmecp/ q_0, rad_a, & -! R0_unit, r_edge, & -! b0b00, alpha_fix - namelist /vmecp/ s_input, nss, ntheta, nzeta - - namelist /igsp/ s_input, mc_type, q_type, nss, ntheta - namelist /nu_ref/ Nref, & ! reference (electron) density in m^(-3) Lref, & ! reference length (=R_axis) in m Tref, & ! reference main-ion (ranks=1) temperature in keV @@ -494,1309 +400,15 @@ SUBROUTINE set_cnfig iFLR, & ! flag for GK- or DK-limit in collision icheck ! flag for Maxwellain anihilation test (w/ iFLR=0) - tau(:) = 1.0_DP - nu(:) = 0.002_DP - R0_Ln(:) = 2.5_DP - R0_Lt(:) = 7.5_DP - - - read(inml,nml=physp) - - - do is = 0, ns-1 - if( R0_Ln(is) /= 0._DP ) then - eta(is) = R0_Lt(is) / R0_Ln(is) - else - eta(is) = 1.d+20 - end if - end do - - - write( olog, * ) " # Physical parameters" - write( olog, * ) "" - write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) - write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) - write( olog, * ) " # eta = ", eta(:) - write( olog, * ) " # nu = ", nu(:) - write( olog, * ) " # A-number = ", Anum(:) - write( olog, * ) " # Z-number = ", Znum(:) - write( olog, * ) " # fcs = ", fcs(:) - write( olog, * ) " # sgn = ", sgn(:) - write( olog, * ) " # tau = ", tau(:) - write( olog, * ) " # dns1 = ", dns1(:) - write( olog, * ) " # tau_ad = ", tau_ad - write( olog, * ) " # lambda_i^2 = ", lambda_i - write( olog, * ) " # beta_i = ", beta - write( olog, * ) " # ibprime = ", ibprime - write( olog, * ) " # nx0 = ", nx0 - write( olog, * ) "" - - - mach = 0._DP - uprime = 0._DP - gamma_e = 0._DP - - read(inml,nml=rotat) - - write( olog, * ) " # Mean rotation parameters" - write( olog, * ) "" - write( olog, * ) " # Mach number = ", mach - write( olog, * ) " # uptime = ", uprime - write( olog, * ) " # gamma_ExB = ", gamma_e - write( olog, * ) "" - - - n_tht = 1 - - read(inml,nml=nperi) - - - if( trim(equib_type) == "slab") then - - read(inml,nml=confp) - - lprdm1 = 0._DP - lprdp1 = 0._DP - - lmmq = 0._DP - lmmqm1 = 0._DP - lmmqp1 = 0._DP - - q_0 = 1._DP ! For now, fixed q_0=1. Changing q_0 can extend parallel z-box size. - s_hat = 0._DP ! only shear less slab - eps_r = 1._DP - - eps_hor = 0._DP - lprd = 0._DP - mprd = 0._DP - malpha = 0._DP - - rdeps00 = 0._DP - eps_mor = 0._DP - eps_por = 0._DP - - write( olog, * ) " # Configuration parameters" - write( olog, * ) "" - write( olog, * ) " # q_0 = ", q_0 - write( olog, * ) " # s_hat = ", s_hat - write( olog, * ) " # eps_r = ", eps_r - write( olog, * ) "" - - write( olog, * ) " # eps_hor = ", eps_hor - write( olog, * ) " # lprd = ", lprd - write( olog, * ) " # mprd = ", mprd - write( olog, * ) " # malpha = ", malpha - write( olog, * ) " # rdeps00 = ", rdeps00 - - write( olog, * ) " # eps_mor = ", eps_mor - write( olog, * ) " # lprdm1 = ", lprdm1 - write( olog, * ) " # eps_por = ", eps_por - write( olog, * ) " # lprdp1 = ", lprdp1 - write( olog, * ) "" - - else if( trim(equib_type) == "analytic" .OR. & - trim(equib_type) == "s-alpha" .OR. & - trim(equib_type) == "s-alpha-shift" .OR. & - trim(equib_type) == "circ-MHD" ) then - - - read(inml,nml=confp) - - - lprdm1 = lprd - 1.0_DP - lprdp1 = lprd + 1.0_DP - - lmmq = lprd - mprd * q_0 - lmmqm1 = lprdm1 - mprd * q_0 - lmmqp1 = lprdp1 - mprd * q_0 - - - write( olog, * ) " # Configuration parameters" - write( olog, * ) "" - write( olog, * ) " # q_0 = ", q_0 - write( olog, * ) " # s_hat = ", s_hat - write( olog, * ) " # eps_r = ", eps_r - write( olog, * ) "" - - write( olog, * ) " # eps_hor = ", eps_hor - write( olog, * ) " # lprd = ", lprd - write( olog, * ) " # mprd = ", mprd - write( olog, * ) " # malpha = ", malpha - write( olog, * ) " # rdeps00 = ", rdeps00 - - write( olog, * ) " # eps_mor = ", eps_mor - write( olog, * ) " # lprdm1 = ", lprdm1 - write( olog, * ) " # eps_por = ", eps_por - write( olog, * ) " # lprdp1 = ", lprdp1 - write( olog, * ) "" - - - -! else if( trim(equib_type) == "vmec" ) then -! -! -!! --- Paramters at rho=0.65 (shot#088343 at t = 1.833 [s]) -!! -!! Ln_unit =-4.230701_DP ! Ln [m] -!! Lt_unit = 0.3135611_DP ! Lt [m] -!! R0_unit = 3.599858_DP ! R0 [m] -!! r_edge = 0.6362872D0 ! r_edge [m] -!! b0b00 = 2.88846853946973647d0/2.940307D0 ! b00mode/B0 -!! alpha_fix = 0.314159253589793d0 ! pi/10 -!! -! -! read(inml,nml=vmecp) -! -! eps_b = r_edge / R0_unit ! --- a / R ! by nunami (2010.04.21) -! -! rho2R_0 = eps_b / rad_a ! --- rho / R_0 -! rho_unit = rho2R_0 * R0_unit ! --- rho -! r_a = rad_a * rho2R_0 ! --- rad_a / R_0 -! -! eps_r = 0.1115200537d0 -! -! call vmecin_fileopen -! -! -! call vmecin_read -! -! -! q_input = q_0 -! theta = 0._DP -! -! call vmecin_coeff( rad_a, R0_unit, rho2R_0, q_input, theta, & -! alpha_fix, r_0, r_minor, s_hat, & -! gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & -! gupss, guptt, gupzz, gupst, gupsz, guptz, & -! babs, Bs, Bth, Bzt, dBds, dBdt, dBdz, & -! dBdt_mir, vmec_rootg, rootgft, rootgbz ) -! -! -! write( olog, * ) " # Configuration parameters" -! write( olog, * ) "" -! write( olog, * ) " # q_0 = ", q_0 -! write( olog, * ) " # s_hat = ", s_hat -! write( olog, * ) "" -! write( olog, * ) " # eps_r = ", eps_r -! write( olog, * ) "" - - - else if( trim(equib_type) == "vmec" ) then - - - read(inml,nml=confp) - - read(inml,nml=vmecp) - - call vmecbzx_boozx_read( nss, ntheta, nzeta ) - - isw = 0 - iz = 0 - call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, 0._DP, lz_l, & ! input - s_0, q_0, s_hat, eps_r, phi_ax, & ! output - omg(iz), rootg(iz), domgdx, domgdz, domgdy, & - gg(1,1), gg(1,2), gg(1,3), gg(2,2), & - gg(2,3), gg(3,3) ) - - - - write( olog, * ) " # Configuration parameters" - write( olog, * ) "" - write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) - write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) - write( olog, * ) " # eta = ", eta(:) - write( olog, * ) " # q_0 = ", q_0 - write( olog, * ) " # s_hat = ", s_hat - write( olog, * ) " # eps_r = ", eps_r - write( olog, * ) " # s_input, s_0 = ", s_input, s_0 - write( olog, * ) " # nss, ntheta, nzeta = ", nss, ntheta, nzeta - - - else if( trim(equib_type) == "eqdsk" ) then - - - read(inml,nml=confp) - - read(inml,nml=igsp) - - call igs_read( mc_type, nss, ntheta ) - - if ( q_type == 1 ) then - isw = 0 - iz = 0 - call igs_coeff( isw, mc_type, nss, ntheta, s_input, 0._DP, lz_l, & ! input - s_0, q_0, s_hat, eps_r, theta, & ! output - omg(iz), rootg(iz), domgdx, domgdz, domgdy, & - gg(1,1), gg(1,2), gg(1,3), gg(2,2), & - gg(2,3), gg(3,3) ) - end if - - - - write( olog, * ) " # Configuration parameters" - write( olog, * ) "" - write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) - write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) - write( olog, * ) " # eta = ", eta(:) - write( olog, * ) " # q_0 = ", q_0 - write( olog, * ) " # s_hat = ", s_hat - write( olog, * ) " # eps_r = ", eps_r - write( olog, * ) " # s_input, s_0 = ", s_input, s_0 - write( olog, * ) " # nss, ntheta = ", nss, ntheta - - else - - write( olog, * ) " # wrong choice of the equilibrium " - call flush(olog) - call MPI_Finalize(ierr_mpi) - stop - - end if - - -! --- coordinate settings --- - - if (abs(s_hat) < 1.d-10) then ! When s_hat == ZERO - m_j = 0 - kxmin = kymin - else if (m_j == 0) then - kxmin = kymin - else - kxmin = abs(2._DP * pi * s_hat * kymin / real(m_j, kind=DP)) - end if - lx = pi / kxmin - ly = pi / kymin - ! kymin=pi/ly=pi/[r_minor*pi/(q0*n_alp)]=q0*n_alp/r_minor - - lz = real( n_tht, kind=DP ) * pi ! total z-length - lz_l = lz / real( nprocz, kind=DP ) ! local z-length - - do mx = -nx, nx - kx(mx) = kxmin * real( mx, kind=DP ) - end do - - ky(:) = 0._DP - do my = ist_y_g, iend_y_g - ky(my-ist_y_g) = kymin * real( my, kind=DP ) - end do - - kxmin_g = kxmin - kymin_g = kymin - - z0 = - lz ! global lower boundary - z0_l = 2._DP * lz_l * real( rankz, kind=DP ) + z0 - ! local lower boundary - - dz = lz_l / real( nz, kind=DP ) - - do iz = -nz, nz-1 - zz(iz) = dz * real( iz + nz, kind=DP ) + z0_l - end do - - - dv = 2._DP * vmax / real( 2 * nv * nprocv -1, kind=DP ) - - do iv = 1, 2*nv - global_iv = 2 * nv * rankv + iv - vl(iv) = dv * ( real( global_iv - nv * nprocv - 1, kind=DP ) + 0.5_DP ) - end do - ! --- debug - ! write( olog, * ) " *** iv, vl " - ! do iv = 1, 2*nv - ! global_iv = 2 * nv * rankv + iv - ! write( olog, * ) iv, global_iv, vl(iv) - ! end do - ! write( olog, * ) "" - - mmax = vmax - dm = mmax / real( nprocm * ( nm+1 ) - 1, kind=DP ) - ! --- equal spacing in vperp - - do im = 0, nm - global_im = ( nm+1 ) * rankm + im - mu(im) = 0.5_DP * ( dm * real( global_im, kind=DP ) )**2 - end do - - - write( olog, * ) " # Numerical parameters" - write( olog, * ) "" - write( olog, * ) " # n_tht = ", n_tht - write( olog, * ) " # lx, ly, lz = ", lx, ly, lz - write( olog, * ) " # lz, z0 = ", lz, z0 - write( olog, * ) " # lz_l, z0_l = ", lz_l, z0_l - write( olog, * ) " # kxmin, kymin = ", kxmin, kymin - write( olog, * ) " # kxmax, kymax = ", kxmin*nx, kymin*global_ny - write( olog, * ) " # kperp_max = ", sqrt((kxmin*nx)**2+(kymin*global_ny)**2) - write( olog, * ) " # m_j, del_c = ", m_j, del_c - write( olog, * ) " # dz = ", dz - write( olog, * ) " # dv, vmax = ", dv, vmax - write( olog, * ) " # dm, mmax = ", dm, mmax - write( olog, * ) "" - - if (gamma_e == 0._DP) then - tlim_exb = 999999.d0 - else - tlim_exb = (kxmin*(nx-nx0))/(kymin*global_ny*abs(gamma_e)) - end if - write( olog, * ) " # ExB limit time tlim_exb = ", tlim_exb - write( olog, * ) " # for (mx=nx0,my=global_ny) initial perturbation: " - write( olog, * ) " # tlim_exb = kxmin*(nx-nx0)/(kymax*|gamma_e|)" - write( olog, * ) "" - - -! --- coordinate settings --- - - -! --- operator settings --- - - - do iz = -nz, nz-1 - -!!! for slab model - if ( trim(equib_type) == "slab") then - - q_bar = q_0 - r_major = 1._DP ! in the R0 unit - theta = zz(iz) - - omg(iz) = 1._DP - rootg(iz) = q_0*r_major - dpara(iz) = dz * q_0 * r_major - - do im = 0, nm - vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) - mir(iz,im) = 0._DP - do iv = 1, 2*nv - vdx(iz,iv,im) = 0._DP - vdy(iz,iv,im) = 0._DP - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - end do - end do ! im loop ends - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 - end do - end do - - baxfactor = 1._DP - - !- for OUTPUT hst/*.mtr.* - - domgdz = 0._DP - domgdy = 0._DP - domgdx = 0._DP - gg(1,1) = 1._DP - gg(1,2) = 0._DP - gg(1,3) = 0._DP - gg(2,1) = gg(1,2) - gg(2,2) = 1._DP - gg(2,3) = 0._DP - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = 1._DP - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - -!!! for the concentric and large-aspect-ratio model !!! - else if( trim(equib_type) == "analytic" ) then - - q_bar = q_0 - r_major = 1._DP ! in the R0 unit - - theta = zz(iz) - - omg(iz) = 1._DP & - - eps_r * ( cos( zz(iz) ) & - + eps_hor * cos( lmmq * zz(iz) - malpha ) & - + eps_mor * cos( lmmqm1 * zz(iz) - malpha ) & - + eps_por * cos( lmmqp1 * zz(iz) - malpha ) ) - - rootg(iz) = q_0*r_major/omg(iz) - dpara(iz) = dz * q_0 * r_major - - ! --- debug - ! write( olog, * ) " *** z, omg " - ! do iz = -nz, nz-1 - ! write( olog, * ) zz(iz), omg(iz) - ! end do - ! write( olog, * ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & - * ( sin(zz(iz)) & - + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) - - do iv = 1, 2*nv - !do my = ist_y, iend_y - ! do mx = -nx, nx - ! kvd and kvs are revised November 2011 - ! into general species forms. - !!!!kvd(mx,my,iz,iv,im)= & - !!!! - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & - !!!! * ( ky(my) * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & - !!!! + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - !!!! + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - !!!! + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & - !!!! + ( kx(mx) + s_hat * zz(iz) * ky(my) ) & - !!!! * ( sin( zz(iz) ) & - !!!! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - !!!! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - !!!! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - !!!! ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - !!!!kvs(mx,my,iz,iv,im) = & - !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & - !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - !!!! + omg(iz)*mu(im) - 1.5_DP ) ) - - !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% - !%%% kvs = ky(my) * vsy(iz,iv,im) %%% - vdx(iz,iv,im)= & - - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & - * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & - + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & - + ( 1._DP + s_hat * zz(iz) * 0._DP ) & - * ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im)= & - - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & - * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & - + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & - + ( 0._DP + s_hat * zz(iz) * 1._DP ) & - * ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - - ! end do - !end do - end do - - end do ! im loop ends - - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = ( kx(mx) + s_hat * zz(iz) * ky(my) )**2 + ky(my)**2 - end do - end do - - baxfactor = 1._DP - - !- for OUTPUT hst/*.mtr.* - !%%% under benchmark %%% - domgdz = eps_r * ( sin(zz(iz)) & - + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) - domgdy = - eps_rnew / r_major * ( & - - ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) & - ) - (-1._DP/eps_r) * domgdz ) - domgdx = eps_rnew / r_major * ( & - - ( & - rdeps00 & - + rdeps1_0 * cos( zz(iz) ) & - + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) & - + s_hat * zz(iz) * ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - ) - (-s_hat*zz(iz)/eps_r) * domgdz ) - gg(1,1) = 1._DP - gg(1,2) = s_hat*zz(iz) - gg(1,3) = 0._DP - gg(2,1) = gg(1,2) - gg(2,2) = 1._DP + (s_hat*zz(iz))**2 - gg(2,3) = 1._DP/(r_major*eps_r) - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = 1._DP/((r_major*eps_r)**2) - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - -!!! for s-alpha !!! <--- the current version is the same as "analytic" - else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then - - q_bar = q_0 - r_major = 1._DP ! in the R0 unit - - if (trim(equib_type) == "s-alpha") then - !--- s-alpha model without Shafranov shift - - alpha_MHD = 0._DP - else if (trim(equib_type) == "s-alpha-shift") then - !--- s-alpha model with Shafranov shift ---- - p_total = 0._DP - dp_totaldx = 0._DP - beta_total = 0._DP - do is = 0, ns-1 - p_total = p_total + fcs(is) * tau(is) / Znum(is) - dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) - beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) - end do - alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total - end if - - theta = zz(iz) - - omg(iz) = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion - !omg(iz) = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark - - rootg(iz) = q_0*r_major/omg(iz) - dpara(iz) = dz* q_0 * r_major - - domgdz = eps_r * sin( theta ) - !domgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark - domgdx = -cos( theta ) / r_major - domgdy = 0._DP - - - gg(1,1) = 1._DP - gg(1,2) = s_hat*zz(iz) - alpha_MHD*sin(zz(iz)) ! with Shafranov shift - gg(1,3) = 0._DP - gg(2,1) = gg(1,2) - gg(2,2) = 1._DP + (s_hat*zz(iz) - alpha_MHD*sin(zz(iz)))**2 ! with Shafranov shift - gg(2,3) = 1._DP/(r_major*eps_r) - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = 1._DP/((r_major*eps_r)**2) - - kkx = -r_major * (q_0/q_bar) & - * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz - kky = r_major * (q_bar/q_0) & - * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - !do my = ist_y, iend_y - ! do mx = -nx, nx - - !!!!kvd(mx,my,iz,iv,im) = & - !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & - !!!! * ( kkx*kx(mx) + kky*ky(my) ) & - !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - !!!!kvs(mx,my,iz,iv,im) = & - !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & - !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - !!!! + omg(iz)*mu(im) - 1.5_DP ) ) & - !!!! * (q_bar/q_0) - - !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% - !%%% kvs = ky(my) * vsy(iz,iv,im) %%% - vdx(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) & - * (q_bar/q_0) - - ! end do - !end do - end do - - end do ! im loop ends - - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = ( kx(mx) + ( s_hat * zz(iz) - alpha_MHD*sin(zz(iz)) ) & - * ky(my) )**2 + ky(my)**2 ! with Shafranov shift - end do - end do - - baxfactor = 1._DP - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - -!!! for circular MHD equilibrium !!! - else if( trim(equib_type) == "circ-MHD" ) then - - q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 - r_major = 1._DP ! in the R0 unit - - theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & - * tan(zz(iz)/2._DP) ) - - omg(iz) = sqrt( q_bar**2 + eps_r**2 ) & - / ( 1._DP + eps_r*cos( theta ) ) / q_bar - - rootg(iz) = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 - dpara(iz) = dz * omg(iz) * rootg(iz) - - - domgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & - / ( 1._DP + eps_r * cos( theta ) )**2 & - / ( 1._DP - eps_r * cos( zz(iz)) ) / q_0 - - domgdx = -( cos(theta) & - - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & - *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & - - eps_r*sin(theta)**2/(1._DP-eps_r**2) & - ) / ((1._DP + eps_r*cos(theta))**2) & - * sqrt(q_bar**2+eps_r**2) / q_bar / r_major - - domgdy = 0._DP - - gg(1,1) = (q_0/q_bar)**2 - gg(1,2) = ( s_hat*zz(iz)*q_0/q_bar - eps_r*sin(zz(iz))/(1._DP-eps_r**2) )*q_0/q_bar - gg(1,3) = - sin(zz(iz))/(1._DP-eps_r**2)/r_major*q_0/q_bar - gg(2,1) = gg(1,2) - gg(2,2) = (s_hat*zz(iz)*q_0/q_bar)**2 - 2._DP*q_0/q_bar*s_hat*zz(iz)*eps_r*sin(zz(iz))/(1._DP-eps_r**2) & - + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & - + (eps_r*sin(zz(iz)))**2/(1._DP-eps_r**2)**2 - gg(2,3) = ( -s_hat*zz(iz)*q_0/q_bar*sin(zz(iz))/(1._DP-eps_r**2) & - + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & - + eps_r*(sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & - ) / r_major - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & - + (sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & - ) / (r_major**2) - - kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) - kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - !do my = ist_y, iend_y - ! do mx = -nx, nx - - !!!!kvd(mx,my,iz,iv,im)= & - !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - !!!! * ( kkx*kx(mx) + kky*ky(my) ) & - !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - !!!!kvs(mx,my,iz,iv,im) = & - !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & - !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - !!!! + omg(iz)*mu(im) - 1.5_DP ) ) - - !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% - !%%% kvs = ky(my) * vsy(iz,iv,im) %%% - vdx(iz,iv,im)= & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im)= & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - - - ! end do - !end do - end do - - end do ! im loop ends - - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & - + 2._DP*kx(mx)*ky(my)*gg(1,2) & - + (ky(my)**2)*gg(2,2) - end do - end do - - baxfactor = 1._DP - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - -!!!! for VMEC equilibrium !!! -! else if( trim(equib_type) == "vmec" ) then -! -! q_bar = q_0 -! theta = zz(iz) -! -! call vmecin_coeff( rad_a, R0_unit, rho2R_0, q_input, theta, & -! alpha_fix, r_0, r_minor, s_hat, & -! gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & -! gupss, guptt, gupzz, gupst, gupsz, guptz, & -! babs, Bs, Bth, Bzt, dBds, dBdt, dBdz, & -! dBdt_mir, vmec_rootg, rootgft, rootgbz ) -! -! omg(iz) = babs -! -! rootg(iz) = vmec_rootg * R0_unit * R0_unit * R0_unit -! dpara(iz) = dz * babs * rootgft * b0b00 -! -! -! -! do im = 0, nm -! -! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -! mir(iz,im) = mu(im) * dBdt_mir / babs / rootgft / b0b00 -! -! do iv = 1, 2*nv -! do my = ist_y, iend_y -! do mx = -nx, nx -! -! kvd(mx,my,iz,iv,im) = & -! - (( vl(iv)**2 + omg(iz)*mu(im) ) / rootgbz /babs/babs/babs ) & -! * ((r_0/q_0) * ky(my) & -! * ( ( (Bs/r_a) + Bzt * (q_0/r_0) * s_hat * zz(iz) ) * dBdt & -! +( (Bs/r_a) * q_0 - Bth * (q_0/r_0) * s_hat * zz(iz) ) * dBdz & -! -( Bth + Bzt * q_0 ) * dBds / r_a ) & -! + kx(mx) * ( Bzt * dBdt - Bth * dBdz )) & -! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -! ! --- k*v_d term -! -! kvs(mx,my,iz,iv,im) = & -! - sgn(ranks) * ky(my) & -! * ((r_0/q_0) * (Bth + Bzt * q_0) / rootgbz / babs / babs) & -! * ( R0_Ln(ranks) & -! + R0_Lt(ranks) * (0.5_DP*vl(iv)**2 + omg(iz)*mu(im) - 1.5_DP) ) & -! * tau(ranks) / Znum(ranks) -! ! --- k*v_* term -! end do -! end do -! end do -! -! end do ! im loop ends -! -! -! do my = ist_y, iend_y -! do mx = -nx, nx -! ksq(mx,my,iz) = (r_a * kx(mx))**2 * gupss & -! + ky(my)**2 * ( (r_0/q_0)**2 & -! * ( gupzz + guptt * q_0 **2 - guptz * 2._DP * q_0 ) & -! + 2._DP * s_hat * (r_0/q_0) * zz(iz) * r_a * ( gupst * q_0 - gupsz ) & -! + r_a * r_a * gupss * (s_hat**2) * (zz(iz)**2) ) & -! + (r_a * kx(mx)) * ky(my) * 2._DP * ( (r_0/q_0) & -! * ( gupst * q_0 - gupsz ) + r_a * gupss * s_hat * zz(iz) ) -! ! --- squere of k_perp -! end do -! end do -! -! baxfactor = b0b00 ! --- For the use in caldlt -! - -! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) - else if( trim(equib_type) == "vmec" ) then - - q_bar = q_0 - isw = 1 - r_major = 1._DP ! in the R0 unit - - call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz(iz), lz_l, & ! input - s_0, q_0, s_hat, eps_r, phi_ax, & ! output - omg(iz), rootg(iz), domgdx, domgdz, domgdy, & - gg(1,1), gg(1,2), gg(1,3), gg(2,2), & - gg(2,3), gg(3,3) ) - - dpara(iz) = dz * omg(iz) * rootg(iz) - - kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) - kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - !do my = ist_y, iend_y - ! do mx = -nx, nx - - !!!!kvd(mx,my,iz,iv,im) = & - !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - !!!! * ( kkx*kx(mx) + kky*ky(my) ) & - !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & - !!!! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term - !!!! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks))*ky(my) ) & - !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - !!!!kvs(mx,my,iz,iv,im) = & - !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & - !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - !!!! + omg(iz)*mu(im) - 1.5_DP ) ) - - !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% - !%%% kvs = ky(my) * vsy(iz,iv,im) %%% - vdx(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - - vdy(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & - - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term - * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - - - ! end do - !end do - end do - - end do ! im loop ends - - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & - + 2._DP*kx(mx)*ky(my)*gg(1,2) & - + (ky(my)**2)*gg(2,2) - end do - end do - - baxfactor = 1._DP - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = phi_ax ! [ 2] Axisymetric toroidal angle - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - - else if( trim(equib_type) == "eqdsk" ) then - - q_bar = q_0 - isw = 1 - r_major = 1._DP ! in the R0 unit - - call igs_coeff( isw, mc_type, nss, ntheta, s_input, zz(iz), lz_l, & ! input - s_0, q_0, s_hat, eps_r, theta, & ! output - omg(iz), rootg(iz), domgdx, domgdz, domgdy, & - gg(1,1), gg(1,2), gg(1,3), gg(2,2), & - gg(2,3), gg(3,3) ) - - dpara(iz) = dz * omg(iz) * rootg(iz) - - kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) - kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - !do my = ist_y, iend_y - ! do mx = -nx, nx - - !!!!kvd(mx,my,iz,iv,im) = & - !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - !!!! * ( kkx*kx(mx) + kky*ky(my) ) & - !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & - !!!! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term - !!!! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks))*ky(my) ) & - !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - !!!!kvs(mx,my,iz,iv,im) = & - !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & - !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - !!!! + omg(iz)*mu(im) - 1.5_DP ) ) - - !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% - !%%% kvs = ky(my) * vsy(iz,iv,im) %%% - vdx(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & - - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term - * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - - - ! end do - !end do - end do - - end do ! im loop ends - - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & - + 2._DP*kx(mx)*ky(my)*gg(1,2) & - + (ky(my)**2)*gg(2,2) - end do - end do - - baxfactor = 1._DP - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - - else - - write( olog, * ) " # wrong choice of the equilibrium " - call flush(olog) - call MPI_Finalize(ierr_mpi) - stop - - end if - - - do im = 0, nm - do my = ist_y, iend_y - do mx = -nx, nx - kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & - * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) - call math_j0( kmo, j0(mx,my,iz,im) ) - call math_j1( kmo, j1(mx,my,iz,im) ) - call math_j2( kmo, j2(mx,my,iz,im) ) - end do - end do - end do - - - do my = ist_y, iend_y - do mx = -nx, nx - bb = ksq(mx,my,iz) / omg(iz)**2 & - * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) - call math_g0( bb, g0(mx,my,iz) ) - end do - end do - - -!!!! debug (Jan 2012) -! write( olog, fmt="(1p,10e15.7)" ) & -! zz(iz), omg(iz), mir(iz,0), dpara(iz), jcob(iz), & -! ksq(1,2,iz), kvs(1,2,iz,1,0), kvd(1,2,iz,1,0), j0(1,2,iz,0), g0(1,2,iz) -!!!! debug (Jan 2012) - - - end do ! iz loop ends - -!- OUTPUT ascii data hst/*.mtr.* - - call MPI_gather(metric_l(1,-nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & - metric_g(1,-global_nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & - 0, zsp_comm_world, ierr_mpi) - if ( rankg == 0 ) then - do iz = -global_nz, global_nz-1 - write( omtr, fmt="(f15.8,SP,256E24.14e3)") metric_g(:,iz) - end do - call flush(omtr) - end if -!--------------------------------- - -! --- operator settings --- - - - cfsrf = 0._DP - cfsrf_l = 0._DP - do iz = -nz, nz-1 -! cfsrf_l = cfsrf_l + 1._DP / omg(iz) - cfsrf_l = cfsrf_l + rootg(iz) - ! normalization coefficient for - ! the surface average - end do - - call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & - MPI_SUM, zsp_comm_world, ierr_mpi ) - - - ! --- debug - ! write( olog, * ) " *** z, omg " - ! do iz = -nz, nz-1 - ! write( olog, * ) zz(iz), omg(iz) - ! end do - ! write( olog, * ) - - - if ( vel_rank == 0 ) then - do iz = -nz, nz-1 - !dvp(iz) = vp(iz,1) - dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) - end do - end if - - call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & - vel_comm_world, ierr_mpi ) - - - do my = ist_y_g, iend_y_g - ck(my-ist_y_g) = exp( ui * 2._DP * pi * del_c & - * real( n_tht * my, kind=DP ) ) - dj(my-ist_y_g) = - m_j * n_tht * my - ! del_c = q_0*n_alp-int(q_0*n_alp) - ! m_j = 2*n_alp*q_d - end do - - - do im = 0, nm - do iv = 1, 2*nv - do iz = -nz, nz-1 - fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & - / sqrt( twopi**3 ) - end do - end do - end do - - allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) - -! --- GK polarization factor for efield calculation - fct_poisson(:,:,:) = 0._DP - fct_e_energy(:,:,:) = 0._DP - - ww(:,:,:) = 0._DP - do iz = -nz, nz-1 - do my = ist_y, iend_y - do mx = -nx, nx - - if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode - - fct_poisson(mx,my,iz) = 0._DP - fct_e_energy(mx,my,iz) = 0._DP - - else - - ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) - do is = 0, ns-1 - bb = ksq(mx,my,iz) / omg(iz)**2 & - * tau(is)*Anum(is)/(Znum(is)**2) - call math_g0( bb, gg0 ) - ww(mx,my,iz) = ww(mx,my,iz) & - + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) - end do - fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) - fct_e_energy(mx,my,iz) = ww(mx,my,iz) - - end if - - end do - end do - end do - - -! --- ZF-factor for adiabatic model - if ( ns == 1 ) then - - ww(:,:,:) = 0._DP - do iz = -nz, nz-1 - my = 0 - do mx = -nx, nx - ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & - / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) - end do - end do - - call intgrl_fsrf ( ww, fctgt ) - - if ( rankw == 0 ) then - fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) - ! g0(0,0,iz) has no z dependence - endif - - endif - - deallocate( ww ) - - allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) - allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) - wf(:,:,:,:,:) = ( 0._DP, 0._DP ) - nw(:,:,:) = ( 0._DP, 0._DP ) - -! --- GK polarization factor for mfield calculation - fct_ampere(:,:,:) = 0._DP - fct_m_energy(:,:,:) = 0._DP - - if ( beta .ne. 0._DP ) then - - do im = 0, nm - do iv = 1, 2*nv - do iz = -nz, nz-1 - do my = ist_y, iend_y - do mx = -nx, nx - wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & - * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) - end do - end do - end do - end do - end do - - call intgrl_v0_moment_ms ( wf, nw ) - - do iz = -nz, nz-1 - do my = ist_y, iend_y - do mx = -nx, nx - fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) - fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta - end do - end do - end do - - if ( rankw == 0 ) then - do iz = -nz, nz-1 - fct_ampere(0,0,iz) = 0._DP - fct_m_energy(0,0,iz) = 0._DP - end do - end if - - end if - - deallocate( wf ) - deallocate( nw ) +! --- read GKV namelist relating to configurations --- + call geom_read_nml +! --- coordinate settings (time-indep.) --- + call geom_init_kxkyzvm(lx, ly, eps_r) ! --- set collision frequencies and v-space functions for multi-species GK collision read(inml,nml=nu_ref) call colli_set_param(q_0, eps_r, nust) - !if (trim(time_advnc) == "imp_colli" .or. trim(time_advnc) == "auto_init") then - if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then - call colliimp_set_param - end if - !!! call colliimp_set_param - call dtc_init( lx, ly, vmax ) - write( olog, * ) " # Collision parameters" write( olog, * ) "" write( olog, * ) " # Nref [m^-3] = ", Nref @@ -1826,6 +438,17 @@ SUBROUTINE set_cnfig write( olog, * ) +! --- coordinate settings (explicitly time-dependent metrics) --- + call geom_init_metric + +! --- operator settings (time-dependent through metrics) --- + call geom_set_operators + if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then + call colliimp_set_param + end if + +! --- initial estimate of time steps --- + call dtc_init( lx, ly, vmax ) END SUBROUTINE set_cnfig @@ -1969,6 +592,15 @@ SUBROUTINE set_value( ff, phi, Al, hh, time ) end if + !%%% For shearflow rotating flux tube model %%% + if (gamma_e /= 0._DP .and. trim(flag_shearflow) =="rotating") then + call geom_reset_time(time) + if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then + call colliimp_set_param + end if + end if + !%%% + call bndry_zvm_bound_f( ff ) call fld_esfield( ff, phi ) From b2a8c99320d2ae7ca55637506e0abcb785858590 Mon Sep 17 00:00:00 2001 From: smaeyama Date: Tue, 14 Mar 2023 15:20:59 +0900 Subject: [PATCH 2/6] equib_type=ring is added. gkvp_geom.f90 is tested for all equib_type. --- .../{ => backup}/fig_stdout_20210316.tar.gz | Bin extra_tools/fig_stdout_f0.62.tar.gz | Bin 0 -> 14418 bytes lib/gkvp_math_portable.f90 | 199 +- run/backup/Makefile_ps_sx | 12 +- run/backup/Makefile_ubuntu | 168 +- run/backup/Makefile_ubuntu_old | 128 ++ run/backup/sub.q_ps_sx | 4 +- run/diff.txt | 1529 -------------- run/gkvp_namelist | 5 +- src/gkvp_dtc.f90 | 4 +- src/gkvp_geom.f90 | 1857 +++++++++-------- src/gkvp_header.f90 | 1 + src/gkvp_main.f90 | 4 +- src/gkvp_ring.f90 | 474 +++++ src/gkvp_set.f90 | 5 +- src/gkvp_vmecbzx.f90 | 25 +- 16 files changed, 1914 insertions(+), 2501 deletions(-) rename extra_tools/{ => backup}/fig_stdout_20210316.tar.gz (100%) create mode 100644 extra_tools/fig_stdout_f0.62.tar.gz create mode 100644 run/backup/Makefile_ubuntu_old delete mode 100644 run/diff.txt create mode 100644 src/gkvp_ring.f90 diff --git a/extra_tools/fig_stdout_20210316.tar.gz b/extra_tools/backup/fig_stdout_20210316.tar.gz similarity index 100% rename from extra_tools/fig_stdout_20210316.tar.gz rename to extra_tools/backup/fig_stdout_20210316.tar.gz diff --git a/extra_tools/fig_stdout_f0.62.tar.gz b/extra_tools/fig_stdout_f0.62.tar.gz new file mode 100644 index 0000000000000000000000000000000000000000..48bf254c88c835d23cd718ea96832c7f9e30bead GIT binary patch literal 14418 zcma)iWl$aA5+&{y+}#r-xVuA;0KtL~Y6)z)s+ z)>iHQ=u>BAy6fwy`ewRM&(M5BgQHo)u!KWAGd}fN7y5p&<%iK+W3b-Hl)S((J(P9+ z$7|;9qP(IjWmDK@FT6-jX*XIhC6#0Ry2}L~iRlm1$L2H3V1j~Z+AAVWIE)BYqR}-u zFY(1}{~LYV`?3e`MO65KLY4rQXyeAM6Gzxq_~nqZUXq`95lieTiq=wftjJCQeIDTnvl>1^1+zN;0^_PLaz5bw_h@ zX$6*A4A(@N(C?F03M+7!688kttazOOvs~-57DiW+{!K)R?;E11+75P*zb(`%AKUG+ zKIl*&qkpzp=*=1DG9)0#zp&y6IKP(W(G<4a{ zAWNS;u8n+Lj&w?|Ty;>c&1kmL|K&zm{wKc+XW?tlYM%Pzy$7Ui5 z{l99B61Jz`@PZe}hu~JYMv~gnMV8-(Dm?OegpQ<#1^EJxhq%XEb0ChRi?0c=(FJFt z7KT9$rKdwZ()QmE45QiVD+3>o(~I%b`HOtNo)fn*N#onM6e2HScb6+?I;|z}yK_lu zP&$@a04Jm^hNUO#DXX=cHxZcJ;a^eA-oJ#Vc9Dtnwoy&pX_h>?LOKNIYKw{|4|${v z6$@2$u3g0UrJ0;Dpi?tMiywN+#NfVhP-Cu8Vu$cq{Z}DbDD|~cSw%BzK)TfxSgKf(Mg{8gpx%g^LTgWBWtHg4fuLigcW_!0c*hJPg|rvrbv zSK3EG)K8GBPvP7isi{u!g(}f(BQ*3(`lx|pY|kz>p*L9M{vah4VIs3hlvSXS*Ps|Q zrst@}+o(*a@SZOzrBwgcnxGR|#4>1|@D(*LRRlZEO_bu7CNncL^26wG=Zed?Yg7zx z|FWDkftpJ5T-{Hl%8VpohHam!I(K8)4mvChk-=Y9!Tpz!#Fws);5gmxQK+v z7B~y%gv$NQilAS}xQ-KQSYkBvR3dEb7_zUs^hDxpZ!t<UU< zC4K#Ag_vBv?o6s}+5TE>SGaGrQ@8ZC!oB?%X=+U8UE%yYdOtgMKM&X&^HZ-jjLIVFWIGHvTBv^p2HWt{S6?~PE> zRz8Ix!NwikB#aJeQOmXvg?Z@1zB7w{Y?z50Gsj!CETPygI2XOYz2*3{UAr(KQV`>1=dgPzO7| z_8`{RqQpZsA&eR#90?(l)?yIiE9b@$J|tIgwN*2xJVtIJ>o0mA;dTuF5h-dUl`YYE zXtIQ2_!;XvgCRA!HmTxpCyA5yKQfxnX)GElYY}@pdXsAF`=8+Xkp$v@!Na2wRtY8d z#qWnt%d%2zTWE{9Cu&0!=YG#-4hYFQw2&(PcPS@)hp+frC{~n;Y$n7WoT5Updx}IE z;^k|cNkJS(-fCO6sK_c9fgtNjnm6*1n*@bqAHHq~ka!=Bef~rDb+t8d@VFzY+vU3w z-FX##sjih$+Y#%N-BY1_@-Jj_0!Xc9oNh#NA-5)m6*(6w zKD&H1w)NHj;H%Qev+t%C#aSmyvMg)dZQFmhD7pFS;I$MmR9hV3%%?AaqDasQMBGgNXfbOV8#;@;& z-P|zCEvmmQV_FL~RQI!TANBW#$LkOxtMH=iUyQmoCZw{2}Z4 zX4g07Y!V47v#RH>S@4c{e1c@WR}GIVHL!)`{vc=}<5kO)iOiJtRWdD^e}VAU)MIEo z!JEJ$s7T`SOmMdws<1I7!7%Oi@Yge;O|QUv*O4oIb3M_ocs9JV-t(-KFyBYTBW9!A2Xp{3H_?gt5!j6)n!s(1?rp4yQ)`JEguTiMFe2Bh)8sDF8p<%kUn|WE#{1trF z0f9X`&%pO2Q2hgpok}X>Rd%! zDk;8Qx<2C)DB?ZFLh0$9J;8qkHLf4PXmH*%t$|ep@q%7$UO>lRQ8)EpaZ9Nm0oSBH zs3heYFj$vB(Y}Rz;a!9P#@xt5@UGBY$dl=XM|iC0gVMQz&_thQqlMU556cS;k1&ir zQxkgn^@&rvCZcZa!9V)^e^Sw%e*w=zy1ruDy%=?Qr{=eCGCg zbR;kf=Da;>xW5&&g>)~%JetAqtOgs0YoLM4OsI|CKc5*{Bx^v}@7?W8N_5(hT_LSx zL+*Z%L$=*6xM~+6h5@nt?w22)dEP_}2 zDEV92AvQ95?45XS=dG-m!E@2J^r&_3!|VUR?!RQj7@fDq&qX@|S=ui5AM!SO zQ`WuH`?mil3qpLzTQ+z+>j*qzSoi+a=lfshNlien;d0|-yLfhN|1fW6IO*5c7Z6|L z1cz9g{>nF$|!w$1fgDKuLIPypMNab;#8Li z{w7-Pu_39Tv0wHeS)Z^iSGy7?nEw{FRzO?0MT^sOo8Ac`IgjF`pKEb2YHakVsQN>w zTx>@A&N{Ybd_ng2aIoBtkz;3eEcS4SFBShVbxey6KN-6C?Cs9bH%xN#RcVZvU5&J;{CPe^DN(gT3HA!qdWq&)8Gx=pP5}1}{<+3QnXX!i)GMaA*4+{C zPqoR0FFa_FqMj>SOhULkU%zYsqf)6)5Ky%1UEo-v{FsM){Kn@^{gA~K6{>OxeSlr0 ziDTJAF~QnD`rSfSWa=y531-0=-rY9^! zX?#Di@xKH}5MN0PIRduc(3o`lUB9QrOQ@cE9luZ70U}fIbQL`qd%qW&RMz#TY_|Rl z?3BD#H$SQ0D#GcMeR&or8SBKo`5p?P+v?K8wR$gSj(yWA7Hyh$$R(}ysZ6tzBDL*6 zE1<4BW7BgTb{~@dt(kE%nGMS~8RxlGtaSfpVEp52dGw{~P7Irm%j8~6VC-YcS^7Bv z3wG72&#GfI0;FG~5fc>n#Nb9U6^V5H-A85ovv9%z96D|~VR(`f+M>PUdxKWIVcO{o zz5Vfi9jpN^BRX}T?4-lLmy#fdE*arlu*-odd_2c3m{kS(1i?)XfJw@Y3w&d5dlf& zx4G}~aU7$X!Q9n=vORkH24qHz7x`zeWU_vKv33l*JR|#R*>j;WM*R}@%loAAHG?Q? z{`8Fd^w#Olia5wp_`V?J%|5VJ>7hZsz7OU*9ytINTmsb0`{O_Z)K7Py;J&KD=rNE= zRn(keBQV|o8U+z>QEp4W4l3avPHZeICN^Qt$AhjeC+F-it;P5&Yv((&;+?2BUoN-q z`jHM#k|yBEB9TLRY2B8NU3DP_QIyX#PkU=QBcGt)oFw35;wgZN-gNW#0Bv_zfXLS` zKv*a-P@0%afRfpA0$?wFeUb5%E|L(;qTQ++0Z{Jvi7GQI_SA}c`6lz-?R_!!Wi~N7%X_$WF*dRo{BUv~u)>Cri zO%so6s<)h;0|GKeiS8O}UrgO0x6m!b2t_I&M1F{Y^S+2huXzDP$pWvr?7ptBL$PCGnsWRu6#)mz-vn}UvC^}!>=&s%Rg zuV2B4MUw}Bw9EzUawCc37`Z`-Sk!9yl`d=RhuncEEbFP;k-bykJ)5vp7(xhnn+P+$ zH8QrJ0iY%+>2`BUlaaA&cT7OoI8zl+H~(%$C+yuE*QZiu+;3lH&WXl>_spj`tq&7R zzlQ^D%f%jSRJIsj+ljN250?Fb49n&XY?Zra zF^onP(P1q9Kbf;MYEw!_Jo%`b2GU=*Pz?awm#}cy=nQ~MKR|LDDhZ2&gb{D*)I)rT}s+E2t`Bx!WjKsX+sq>s44EtviH-w$?F0483Xnw zzjg7KQ~15O(e;6WY&RU?j$>fSLr>fws!^ti&Iqo}4(0&gjrjD2r9QzioDWG~7d=E7 z9-c!@ssyQ-6`uUrWL;f~F#``p;!4BE-#6HbYNV;4*=Zb;PlmVumv!;Ol&4$H>37QQ zzj7BZpn%MKNwKE~Q!4Y>b7dHeE92kp7p(zCXB?qmi5vLFYKyNQj4O!^UlPA@Kt~h1 z?=q+^%U5ndpT9g`mU1Q4=T)@~eh>Kk1+{Oo@c6ZxL(b#KDVR{xL=VDc%j3fpHobmQI}fSK}%gfEUAX zfR`Iq?4{#~nvxZ)YXLz9eHntQF`Tatae*?$4k2K{7@d(H#AGj?xAvtTLBrut5;ydb z0|0(t=N@!;2)qR39u|i}Yr&bNTAug*Z)ZuJkr zCwm1!@Yts&lX;)!Mq8hN^it^!zymC}eF}sjkph+rUGs)h+I)EdGk0Zp0o`}<6B(*= zd4m$~RA!pZXg9Q(h8iz6aKW(a>n3UEeThCA;freIzvD4pF(RNP6VupDNe3I7{+@T) zn07Sddf|VIxI(}8Uuk~Zzew4zP0Gm$#9Nr5nt0dCm?hftF$)!cT&$fnU6?m}fgzXkfYP(@g{*t2Orywq$I^#N9&fC&58XHn)(KvRdqjkaMWh*lHAYR(tX z{1Zv=Gyu-h-!)q^LT!2#c+>!!`_W==e!Q@@dew(LkqifMc>x;qZUGP)`UWV-*7%sV z9@HWRiKK>TLs3!6yngtQW1&vTm+JlU91fGl?NndRp%-zSi@qZ~4zQS75F0CvA6@A$ zoxvLe8+ecX#QQ2nlbK7-H_BS_4L&;I1F|icPCWDL%bHfL*UST>h~6oa9X z&+P@U?*F@dB;IMuCMW{KrymoA!-Up5;0Mo2hRPz5Cs}zc?rn6v1!j#;yb~JpAPCf> zTHC^;+GJC%F`)1KDBM%|dgtD%>++xgnw#T7s}r0QuA!`CU{mfmt>qqAXOQQnMNsO# z?5td%Vux#Rrd?S!@Bw>ooqj=zQVIL`-dHD_k|^Z@hm44TK}g3ie1gT>n3I+06E;O_ zm8AaqZPray+utu(QNNg&_Uhuw@p)>fsd<=3T*qw5nLYOE;>#^~1aHZ({IL%ca(-dg zO~rQ!WJ`~^wp5KKy?-D1O${;Sq&7e*GGb zgEGTQ@wYmZKT>GOm~ES-28ZwSVA?>oIGa;0cSDjtnx>{QyllztgcdWa_m7>IZ$06< zksWVoZLrm(lXMnoQmftJzhCK{!$SsoW%$e4eUZq>gx^Nz4yXL|aZi_>zDer3MEPg# z`&W7jIDy0aS0y>QWOCE{<5^>M`(x{wQ#LJ0f-*0l>aYP774-BUthg=w%zAaM zY`UOWnC7PmX?OCrt{e{)a-B)p>~gr!{M2eLT+TRM1I)^%{J=DRF1zgA>ZZdVO~g6} z5wX=ZrDsQ(?6Q^RXNm8WP@5SPe;ZyIVFg4fqoZPzKHx+|8Y`Jb<91cMtTYl%hpv8)@u$dq>C-S)pYpuYnv9iQ zA=>xD{U1#MIO3Y{dPQbwkA$%w#Ugh3dNorI*$B&gF^27$HQT@X7{z)g2Nb=V(q;YN zL83Ch5z)j~r>UWOt-hdFSzpFCrTq`z#S_`1G%sM;R*}tq(xp;)g9M`m?ba@KXx9bdk%wf~M zpK z=9lD?twp(6;}|@seQj%m0p!{t0@v zzZLC$U{b2yvACCNaautM7C#`}VH+*#Eoj3qsZcPj$@O}@4gKTsrg(T2=&{;HXnTH09|5C zsTu$@=m5;ySA7Ra5Q<++$r?dJv6ZdA)t5umTKc?xDj^*QnokAq7`qU)=!f^ydG2Ax zw39^c^EGsB$etOo^S{~1HEsK$9QJ0ln3;o;sIW~%wdkv3usliUCIV<%%V9y^F_elk z(d`vjU3Y!}J_0{TSB7Dr2j)j$_Z8^00l?GN0BC0usOQ}TmXk5@pzcRl>N1Q-H^8%{ zPrfYj|lN1`cLch%S z`z2j{MOQLLN#RLJ`R(T2iMTw+E{`;dSy+NR`#xoUE_)x%fhn-9%z~;TPS&KPzvL4t z=))E2d|&b>)Du3b!i|$aBiaU-!}=e%p<2Lx@Cc~2QUY8eq+q9DW)dKCxIk2Bu&~&w z6S;w5w;AQy?%4CEnx0!%PV}e+2#V91WsQ6o+BQI*^i<3C$qbi`SGcN>C{u@x-p>&( zFPJEEf#nUAhSZvgZS*Rwju2Lz&4=2jRRwEE ze9q8iz9|P_wQ}+nM2BY$tj2IdbM>J_`V&CF1s8{veXZiHd1}?sygO{!uNi6O4RJnA z*E0Bzl=$E^3O92Zwg5W&1|3#E%AT)?!;d%yYOVRR=MtWPe9kLor2UYAb^h@nvQ+<` z<_c}jS3I35d67(!J3Un8!R~DG@5`#M(CtE`D!mpSol>2k7v+xUyQ27cTDDRh^fowC zXNg6#zf}*j5}e5o2z=hc4~4b;k8mx6GnLhca8>fS63xmbJ0#^b<65n#&c7cD)lN7S zplOSB$>=5qdRn0>ci6%?{bRo+T6OPyAu?~QV&Gc9VDHC3ca z0`m#F;St_R++~@!$;S83J>;ZTpT3$Jv@I=4{x)FVMbxX_o1nntzqmAEsu7(+6dg9b zYuOxjMDW*^DYcvWg9!<}=@!)YT@Xx`Mq=G9SRc^H-pK>*%Q=rgZyHE$L6EtN59z2R@PI(e8E0zsfKiDmfpWnkvl?&4m^84E@ZmdLD zlyhZuE)XGQeG9OjZ)|yxYJ7U z5J^H?uq-eQ?h3yZG2SKPKaBHt1}8E}s;E&{*%WNVCez$SKG-LRi+xwl{p#oS?mXzr zn*RCjzNz!B8YNz0yd?n(I5-{LQ$b(Ii@;#3l=5S zOZbNl^#FOXGAGHrA^)0iLv5UVZsjq)>d`5lERrgdAoP*dk=SmtvkFGHlkmUgT*a?X zm0y4VUcYdnX%wHDPE?RY8af84)f!wp&?p$+u7db1A>c2xrchj=fbKP#wXDul{VfxX z+}!lhsCqLF$crZgM>en^BVZaNnGTx2#lFGz|FDoEiW{|nk<{s`N2HZ2GB_9RMvkRO zGGfO=DN9;0?D}^=hy<&GF3w}zHG4ov&VhKldB}|~)`KpgL_1g2jq-59R6D}$FP0*~ zh#fbjF=@rPE0%dK@n99^-e>OINbYH-LA%)9V@FC`4s%KYoMz1bqUwL}>yBIDPq#wM zM8v#!L}MSye@@2(dr~%gQr_{19TsZvZm-~Xj=_6pAne+MEr+miL{WsEE>xL3uNu-;mXKf^GDi%`dtVWXs02v_vk< zXjLqIFdN%(l9VhnQ8LYaNCl_IKD=I%gq-JuH%hdxwJak&68JIOo~|0(+gbJ&GGHK#S^!KQtI$ zrhzePS{tZo?dsJz!1v)VK#cI53sj}%$I*ayXNGZzKrqBpBqy(xIoNfNAZNVk`u6s# z)hbQwk0+$ldk%#kKVg=;p9C95b6UL+aN9A})2S0|xW&ZZnB?t{#axkN)#sztk6)3; zTp423XQ5q&?zG_V81r;v#wm*B$XmQQpp5o9A!G@!66P{tV!GJbRNwlN`XM^a%!Xh;|i@>JZqi5yC`3}};7yE&Jmmdh}r-VT}*Wb}SsWU)+;+?|y zsex-~;nTok!1$SDTPHM860pOr2T)lFl5W9hXk7ppvEH;_L50gEO$Aw)w7i>c+YpG^ zIQ5VGun{P6^9h0wzj%_t_I$&a1^g+vv%XRs%!A`4CC?2_StXFsWv|;f3TGbYmfzu} z+NdsOv&y!^;F>KmLZMo+;w~`c^?F;sy9HYn*mgNRLGaU_%_|t|5$!}Mty~KeM2;W| zUyhzYQh5i1m-tt!cCJ3UeXM2Q=XrBLzW3Q86H}MQnp`wXsa4XoRg$!kB=Zv2TjKkC z0o@BO$P5drTPP?_&=qqnne_+k&{PdU(<)%|@!&C=w`>4^os3V*qU9 z=Ub-QSj*Xi34Ui{TA};cB4Ky!YBnyVt0mpR^oq#-mb;iyGP+McF=>hl*COyfrsDWN zXTbA^UIyaPn|Txb#VL5F5ZxYf(<7;LR%;znt(Zr?CixAZ@@lZ-o$+K|s6z8k& zK}cPR`0TwVZ&+oP7=KEIwaCJ++SE6{BLZ5hUZgW5GLNMh+j;h}Su=Sug`#xCC=W-!;I2_PpqKP z5nt|CH)Yr$9xX_El{RC=YWDD0-KJ)5A?vYXx)eLH`hLpOXToQ~J(%Ux#dkmrSq8S% z76(u64J_Lt4S|v${}sPCuq~_ZBSy|`12hd$Wi$gHy0#RKj zMC-Hoe8$^EW=oAQGjr;DMIzP5#j8qS=^HQ%)|?cB$H!KO4}_U*Nt9Yt73b~Ev((vS z4++nAbRoDMv_-!yms29?CMceJtrg;QLuF0~cBF}6Vcd|V>7ZWQ?4)l7w&Wp-Re&)X zVIz=%vaS5^pU%916IRmm0W!+^XC{V!%=F+cem^77&0eIv) z@hhX>JiB+2%?k5BVW%H-|NavbTg|Yj?05vF+`prFL^UsT<#%)OdM{{NkFE}JK8xa% zS0cRKmszCGYdD|Iw<$Oa7vPl)-l$O3P;{5RQ<(@YRRV3S?buTVOvw<5IM=d9;CRRT z;1koD`+Caw=;CNO;VBK=oVYc(4=N$)9*~H3@SrXtX$85ln`>Hr`le~=0P>W&sG+qd z)|lF@GQi{!ff(&&S!Dm#v4Z4#&T&9% z1XAAE3K#S}~V3AaO? zC=0_O=ChHoT)|)`V_Q{qgr~Ce-j6gfdnz}R#Z~5p&n&%P*kt}BXL_8lN3!&DT@$S{ z>l^cn1(0pLGh?DAOsxpk^fYkCbh{H13K8;a)i$OST<^#=)3*^bNKp*_WiL>UMx1Hi zI<6T)CUpk`-0YwR;Q-el4N%Ya2*^v-Jxba>omBz#ppZ^+qn{yfPfag-tZ**CapGP8 z5ifA`Pl|x~5tS$bWrr3%VE{8E?np9g=R=5x_`?ku_h4c|LMqFCo`&?rbKm23{5^rk z&QY&nAqgC%gR4;3a`&LW;+2cPbqM@UUGTEx_8BBX_QMIYpG2U$FS)!Cr8N#*=XUb@ z%2^yU10F|!1+&^cf@f50&H2h{i{j4{gH#;ErJZ`e7npBOKimS8U%@i8rq48#5@aJF z96ab^bB!E`b=lsD!_6>qF~5HS%O84WvB z-e{j?s(?|`W&_@%Ie(B`B3kuPzRUo%k&3ViyU6{2&wua3*2VQ+2F%G*Wz6#DsXM|& zJZedRTV_yfFn4rbSI%X}!dAv+T`)}V;uZX9-W%p({}E=2wqFmVUBWIYbfGVWXrt;6 zj=#IzQ`p@(G{u+ty{Q4cQ!p6aC~ zzQhSn)H3l)RPym%n|Vz{&6nE8>U9w!rl3|C@9cyJB3cvFp;Pjwc{}*rgW3AJQ6^|Ah3$q>UHaF-g-NMCD zN%GNsEBmh}sVE>MwMD3qRvB|ey742`LnzO;$35S}x8suX$gsd&BM-oxMcF?K&Md)7 zGGEx1&EX>tGDl&fwDP~2&Hq)Pg5&ECmpS>Sdzdvu*u?pih-d2UDZ8>x)f|cqn~)T- zJY7VPACNw2?cyY4Dvj3rPNUd=+@{(Pn5KSS{hOm;kBi2^ zSl=V={z;6&tYr4t9mDkE|0X6u!9g@GYqoVdeX3PtRxT}OZ}zaU5}V*o4-~3cAAG{_ z#&ev1*u<-BC89(jCkHjB!8#ILqXXxQmX++fg_*L-VrB%<=Z+*v$81EmH1KvWK!%-M zFry!w=OBy_v3>AUc*fk+^tzYGT1m3C1)%+>tDwF_Yuu!zTR~aqaF2ZtxUVsc z83K>uyt~;W$ae~%)l**}a(DcMI*S2cH09ENXzD_&)))Vrl}# zwR{L}Z{VzXdcWDMD^FN4?aF7Ki!wMD;g*dxiZ^2SKDU#58hOwTZSONr?!TW8uQM=Q z4R?jehdb~_=h&vpgcADyRI$ft+X!WItB36z4+wpTv_RWyCRH~kJqq373wPrrQ`aU` z{HJ#u(DxeL3XReJix~gG|BEOhp+*&@d$Z(uHpNw+YKe1ISy zC=!4d1-w)80fPYafR{^VQRwZ87q{2%pOT*v+bgMM4^XdcDsT3|ig;51?|UG+4VcX_ zfw?sALtW^S>S0`sz)H!iMt2&j*>!?4#rzGnx{Tj(ER}+bW zZcDjcd=i?|KU>zoy*PG+NQvw1g_jjQ*)=Zw9HhWwE6tBCdLH2Yy7>dJA?1N-(_I4)KF@jElAPhrP$LJo>|xS9dCZ|2>rdRzfPye8k^iH@W_(L zwd9Do2tsl@1@&CC07$_2ttlN|IRKL9ho#+*xj!SG%tUfV1XVu&K^=CM)~{0{2DY))(5@&r)n5IxESV<}}|A?;eTN z{L}v)L5-yP9kRbN-K{FWv&C>SX1os%gnpvft1_ z%eD;;S90uc!CbX4(w^Ls?Sx1a9*;SeSN|#a(%eJIE%v7^z^wFnxlC7tnIGe zmQS*t(iX}5K*U6k3l7Uh`X*Usl?HanK}o(h-Ev37^M|?kodY_?BOp$c-hb!95F|U` zS4Oe>HmlsXkU`}u-@*EZTwhP-)#Iboyx~zk|J6hnT|-0S*tj4r5y9X*Vl4SQd0?1N zBew;Fa<0Zzjqz`!IBhAw9t;{Oan3n7f%CecLx zd;t?9t*}P3%n29@Ubrc@##X*J-6<-m+ zb>|^Xx%EXG+mG=d9X__6LyP_hUELfggBlSI23{QxCMU?@OjJ+p>ZN0%^lo7j*^c&M z%Al4e8mFXHcRDJRIt??QN0eKbyA^Vcrl-4nKd%F7ScAZxjXw1Ir^BZ=rotXLOMP~TlZn)Q=u$uGU>>^0={o4K4ryZ$2pe_3rT3;ss zc_@hN1~`yz9)a44O%Oh!W+k&Kmei%+CmuviOY4|q*(pg`w?=Qvqi^5uG-~`FLr>O|k+B39rjRh#hlh_-v#V8h?=tqkrPnbjqw^(G z`>m$Iqco;g{Ul7(182@#WyAElp{SKEn%yVrQ^5cU#C>A zsrf=lk}_&PVf7M}^(lpN%UuHpka{&nsYZzDzi)I^{}~Lin!pkx7u)a&&eq&K$5tNZ z{ar#+LjwGvC2&hUt=5ANJD{TaL4sp4+zxi_gqBBwPS2pvFm&GsP)|3_m;6)7!Nh3( zU{|;Jyuk2_2vD|3PH%Ad +gkvp_advnc.o : $(SRC)gkvp_advnc.f90 gkvp_geom.o gkvp_tips.o gkvp_zfilter.o gkvp_clock.o gkvp_bndry.o gkvp_colliimp.o gkvp_colli.o gkvp_exb.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_bndry.o : $(SRC)gkvp_bndry.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_clock.o : $(SRC)gkvp_clock.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_colli.o : $(SRC)gkvp_colli.f90 gkvp_bndry.o gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_colliimp.o : $(SRC)gkvp_colliimp.f90 gkvp_fld.o $(MATH).o gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_dtc.o : $(SRC)gkvp_dtc.f90 gkvp_colliimp.o gkvp_exb.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_exb.o : $(SRC)gkvp_exb.f90 gkvp_clock.o $(FFT).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +$(FFT).o : $(SRC)$(FFT).f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< $(INC) +$(FILEIO).o : $(SRC)$(FILEIO).f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< $(INC) +gkvp_fld.o : $(SRC)gkvp_fld.f90 gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_freq.o : $(SRC)gkvp_freq.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_geom.o : $(SRC)gkvp_geom.f90 gkvp_ring.o gkvp_igs.o gkvp_vmecbzx.o gkvp_intgrl.o $(MATH).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_header.o : $(SRC)gkvp_header.f90 + $(FC) $(FFLAGS) -c $< +gkvp_igs.o : $(SRC)gkvp_igs.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_intgrl.o : $(SRC)gkvp_intgrl.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_main.o : $(SRC)gkvp_main.f90 gkvp_shearflow.o gkvp_tips.o gkvp_freq.o $(FFT).o gkvp_colliimp.o gkvp_advnc.o gkvp_fld.o gkvp_dtc.o gkvp_out.o gkvp_clock.o gkvp_set.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_mpienv.o : $(SRC)gkvp_mpienv.f90 gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_out.o : $(SRC)gkvp_out.f90 $(FILEIO).o gkvp_tips.o gkvp_dtc.o gkvp_colliimp.o gkvp_advnc.o gkvp_freq.o gkvp_trans.o gkvp_fld.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_ring.o : $(SRC)gkvp_ring.f90 $(MATH).o + $(FC) $(FFLAGS) -c $< +gkvp_set.o : $(SRC)gkvp_set.f90 gkvp_geom.o $(FILEIO).o gkvp_tips.o gkvp_colliimp.o gkvp_colli.o gkvp_dtc.o gkvp_advnc.o gkvp_bndry.o gkvp_fld.o $(MATH).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_shearflow.o : $(SRC)gkvp_shearflow.f90 gkvp_tips.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_tips.o : $(SRC)gkvp_tips.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_trans.o : $(SRC)gkvp_trans.f90 $(FILEIO).o gkvp_exb.o gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_vmecbzx.o : $(SRC)gkvp_vmecbzx.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_vmecin.o : $(SRC)gkvp_vmecin.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_zfilter.o : $(SRC)gkvp_zfilter.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +$(MATH).o : $(MYL)$(MATH).f90 $(MYL)Bessel0_Zeros.f90 gkvp_header.o + $(FC) $(FFLAGS) -c $< +#------------------------------< clean: rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ diff --git a/run/backup/Makefile_ubuntu_old b/run/backup/Makefile_ubuntu_old new file mode 100644 index 0000000..4b81e37 --- /dev/null +++ b/run/backup/Makefile_ubuntu_old @@ -0,0 +1,128 @@ +#### gfortran + Open-MPI ### +FC = mpifort +FFLAGS = -mcmodel=medium -m64 -march=native -mtune=native -O3 -ffast-math # Optimization +#FFLAGS += -fopenmp # OpenMP +#FFLAGS += -Wall -Wextra -pedantic -fbacktrace \ +# -fbounds-check -Wuninitialized -ffpe-trap=invalid,zero,overflow # Debug +#INC = -I/usr/include +#LIB = -L/usr/lib + + +PROG = 'gkvp.exe' + +SRC = ../src/ +MYL = ../lib/ + +MATH = gkvp_math_portable + +FFT = gkvp_fft_fftw +ifeq ($(FFT),gkvp_fft_fftw) + #FFTW_DIR=`spack location -i fftw` + FFTW_DIR=/usr + INC += -I$(FFTW_DIR)/include + LIB += -L$(FFTW_DIR)/lib -lfftw3 -lm +endif + +FILEIO=gkvp_fileio_fortran +#FILEIO=gkvp_fileio_netcdf +ifeq ($(FILEIO),gkvp_fileio_netcdf) + NETCDF_DIR=`spack location -i netcdf-fortran` + INC += -I$(NETCDF_DIR)/include + LIB += -L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 +endif + + +gkvp: $(SRC)gkvp_header.f90\ + $(SRC)gkvp_mpienv.f90\ + $(MYL)$(MATH).f90\ + $(SRC)gkvp_clock.f90\ + $(SRC)$(FILEIO).f90\ + $(SRC)gkvp_intgrl.f90\ + $(SRC)gkvp_tips.f90\ + $(SRC)gkvp_vmecbzx.f90\ + $(SRC)gkvp_igs.f90\ + $(SRC)gkvp_ring.f90\ + $(SRC)gkvp_bndry.f90\ + $(SRC)gkvp_colli.f90\ + $(SRC)$(FFT).f90\ + $(SRC)gkvp_fld.f90\ + $(SRC)gkvp_colliimp.f90\ + $(SRC)gkvp_freq.f90\ + $(SRC)gkvp_zfilter.f90\ + $(SRC)gkvp_geom.f90\ + $(SRC)gkvp_exb.f90\ + $(SRC)gkvp_trans.f90\ + $(SRC)gkvp_advnc.f90\ + $(SRC)gkvp_shearflow.f90\ + $(SRC)gkvp_dtc.f90\ + $(SRC)gkvp_out.f90\ + $(SRC)gkvp_set.f90\ + $(SRC)gkvp_main.f90 + + $(FC) $(FFLAGS) -c $(SRC)gkvp_header.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_mpienv.f90 + $(FC) $(FFLAGS) -c $(MYL)$(MATH).f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_clock.f90 + $(FC) $(FFLAGS) -c $(SRC)$(FILEIO).f90 $(INC) + $(FC) $(FFLAGS) -c $(SRC)gkvp_intgrl.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_ring.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 + $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) + $(FC) $(FFLAGS) -c $(SRC)gkvp_fld.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_shearflow.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_dtc.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_out.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_set.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_main.f90 + + $(FC) $(FFLAGS) \ + gkvp_header.o\ + gkvp_mpienv.o\ + $(MATH).o\ + gkvp_clock.o\ + $(FILEIO).o\ + gkvp_intgrl.o\ + gkvp_tips.o\ + gkvp_vmecbzx.o\ + gkvp_igs.o\ + gkvp_ring.o\ + gkvp_bndry.o\ + gkvp_colli.o\ + $(FFT).o\ + gkvp_fld.o\ + gkvp_colliimp.o\ + gkvp_freq.o\ + gkvp_zfilter.o\ + gkvp_geom.o\ + gkvp_exb.o\ + gkvp_trans.o\ + gkvp_advnc.o\ + gkvp_shearflow.o\ + gkvp_dtc.o\ + gkvp_out.o\ + gkvp_set.o\ + gkvp_main.o\ + -o $(PROG) $(LIB) + +# cp *.o *.mod *.$(OPTRPT) ../src/ + cp *.o *.mod ../src/ + rm -f *.o *.mod *.$(OPTRPT) + +clean: + rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ + ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* + +clear: + rm -f ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* + diff --git a/run/backup/sub.q_ps_sx b/run/backup/sub.q_ps_sx index 46a59f8..ee004ca 100644 --- a/run/backup/sub.q_ps_sx +++ b/run/backup/sub.q_ps_sx @@ -53,10 +53,12 @@ MPI_procs=32 # number of MPI processes (= venode*8 for flat #PBS -v LANG=C +source /etc/profile.d/modules.sh + module load NECNLC-sx # module load NECNLC-mpi-sx ### For NetCDF -#module load netcdf-parallelIO-fortran-sx/4.5.2 +module load netcdf-parallelIO-fortran-sx ### Working directory diff --git a/run/diff.txt b/run/diff.txt deleted file mode 100644 index 4b28b39..0000000 --- a/run/diff.txt +++ /dev/null @@ -1,1529 +0,0 @@ -diff gkvp/src/gkvp_advnc.f90 src/gkvp_advnc.f90 -19c19 -< use GKV_colliimp, only: colliimp_calc_colli_full, colliimp_set_param ---- -> use GKV_colliimp, only: colliimp_calc_colli_full -25d24 -< use GKV_geom, only: geom_increment_time -97,107d95 -< !%%% For shearflow rotating flux tube model %%% -< if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "rotating") then -< if (istep == 2 .or. istep == 4) then -< call geom_increment_time(0.5_DP * dt) -< if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then -< call colliimp_set_param -< end if -< end if -< end if -< !%%% -< -494c482 -< real(kind=DP) :: cefv, cs1, rotating_cf4, rotating_up5 ---- -> real(kind=DP) :: cefv, cs1 -509,517d496 -< !%%% For shearflow rotating flux tube model %%% -< if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "rotating") then -< rotating_cf4 = - gamma_e / (s_hat_g * 12._DP * (zz(0)-zz(-1))) -< rotating_up5 = - gamma_e / (s_hat_g * 60._DP * (zz(0)-zz(-1))) -< else -< rotating_cf4 = 0._DP -< rotating_up5 = 0._DP -< end if -< !%%% -527,530c506 -< !%%% For shearflow rotating flux tube model %%% -< !!!- vl(iv) * cefz(iz) * ( & -< - (vl(iv) * cefz(iz) + rotating_cf4) * ( & -< !%%% ---- -> - vl(iv) * cefz(iz) * ( & -567,573d542 -< !%%% For shearflow rotating flux tube model %%% -< - rotating_cf4 * ( & -< - ff(mx,my,iz+2,iv) & -< + 8._DP * ff(mx,my,iz+1,iv) & -< - 8._DP * ff(mx,my,iz-1,iv) & -< + ff(mx,my,iz-2,iv) ) & -< !%%% -602,608d570 -< !%%% For shearflow rotating flux tube model %%% -< - rotating_cf4 * ( & -< - ff(mx,my,iz+2,iv) & -< + 8._DP * ff(mx,my,iz+1,iv) & -< - 8._DP * ff(mx,my,iz-1,iv) & -< + ff(mx,my,iz-2,iv) ) & -< !%%% -Only in gkvp/src/: gkvp_geom.f90 -diff gkvp/src/gkvp_header.f90 src/gkvp_header.f90 -41,43c41,43 -< integer, parameter :: nxw = 20, nyw = 20 -< integer, parameter :: nx = 4, global_ny = 1 ! 2/3 de-aliasing rule -< integer, parameter :: global_nz = 12, global_nv = 24, global_nm = 7 ---- -> integer, parameter :: nxw = 2, nyw = 20 -> integer, parameter :: nx = 0, global_ny = 12 ! 2/3 de-aliasing rule -> integer, parameter :: global_nz = 48, global_nv = 24, global_nm = 15 -52c52 -< integer, parameter :: nprocw = 1, nprocz = 2, nprocv = 4, nprocm = 2, nprocs = 1 ---- -> integer, parameter :: nprocw = 2, nprocz = 4, nprocv = 2, nprocm = 2, nprocs = 1 -172c172 -< real(kind=DP) :: mach, uprime, gamma_e, kxmin_g, kymin_g, tlim_exb, s_hat_g ---- -> real(kind=DP) :: mach, uprime, gamma_e, kxmin_g, kymin_g, tlim_exb -203,207d202 -< -< !character(15) :: flag_shearflow = "remap" ! Wavevector remap method -< ! ! with nearest grid approximation -< ! ! (Discontinuous in time) -< character(15) :: flag_shearflow = "rotating" ! Rotating flux tube model -diff gkvp/src/gkvp_main.f90 src/gkvp_main.f90 -139c139 -< if (gamma_e /= 0._DP .and. trim(flag_shearflow) == "remap") then ---- -> if (gamma_e /= 0._DP) then -diff gkvp/src/gkvp_set.f90 src/gkvp_set.f90 -24c24,25 -< use GKV_math, only: math_random ---- -> use GKV_math, only: math_j0, math_j1, math_j2, math_g0, math_random -> use GKV_intgrl, only: intgrl_fsrf, intgrl_v0_moment_ms -28a30,35 -> ! for vmec equilibrium -> ! use GKV_vmecin, only: vmecin_fileopen, vmecin_coeff, vmecin_read -> ! for vmec equilibrium w/ Booz_xform by M. Nakata & M. Nunami (Aug. 2016) -> use GKV_vmecbzx, only: vmecbzx_boozx_read, vmecbzx_boozx_coeff -> ! for tokamak(eqdsk) equilibrium -> use GKV_igs, only: igs_read, igs_coeff -35,37d41 -< use GKV_geom, only : geom_read_nml, geom_init_kxkyzvm, & -< geom_init_metric, geom_set_operators, & -< geom_reset_time -44a49 -> -391a397,443 -> real(kind=DP) :: s_hat -> -> real(kind=DP) :: eps_r -> -> real(kind=DP) :: rdeps00, eps_hor, lprd, mprd, lmmq, malpha -> real(kind=DP) :: eps_mor, eps_por, lprdm1, lprdp1, lmmqm1, lmmqp1 -> real(kind=DP) :: eps_rnew, rdeps1_0, rdeps1_10, rdeps2_10, rdeps3_10 -> -> ! for s-alpha model with Shafranov shift -> real(kind=DP) :: p_total, dp_totaldx, beta_total, alpha_MHD -> -> ! for circular MHD -> real(kind=DP), dimension(1:3,1:3) :: gg -> real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy -> -> -> !! for vmec equilibrium -> ! real(kind=DP) :: rho2R_0, q_input, theta -> ! real(kind=DP) :: r_0 -> ! real(kind=DP) :: gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & -> ! gupss, guptt, gupzz, gupst, gupsz, guptz, & -> ! babs, Bs , Bth , Bzt , dBds, dBdt, dBdz, & -> ! dBdt_mir, vmec_rootg, rootgft, rootgbz -> real(kind=DP) :: theta -> -> -> real(kind=DP) :: lx, ly, lz, kxmin, kymin, dz, mmax, dm, del_c -> real(kind=DP) :: lz_l, z0, z0_l -> integer :: n_tht, m_j -> -> real(kind=DP) :: gg0 -> -> real(kind=DP) :: bb, kmo -> real(kind=DP) :: cfsrf_l -> -> integer :: global_iv, global_im -> integer :: mx, my, iz, iv, im, is, is1, is2, ierr_mpi -> -> -> complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf -> complex(kind=DP), dimension(:,:,:), allocatable :: nw -> real(kind=DP), dimension(:,:,:), allocatable :: ww -> -> ! real(kind=DP) :: rad_a, r_minor, eps_b, rho_unit, r_a -> ! real(kind=DP) :: R0_unit, r_edge, b0b00, alpha_fix -> -> real(kind=DP), dimension(0:ns-1) :: eta -393,394c445 -< real(kind=DP) :: lx, ly, eps_r -< integer :: is1, is2 ---- -> real(kind=DP) :: r_major -395a447,489 -> real(kind=DP) :: s_input, s_0 ! radial label of fluxtube center -> integer :: mc_type ! 0:Axisym., 1:Boozer, 2:Hamada -> integer :: q_type ! 0:use q and s_hat value in confp, 1:calclated by IGS -> integer :: isw, nss, ntheta, nzeta -> real(kind=DP) :: phi_ax ! axisymetric toroidal angle -> -> integer, parameter :: num_omtr = 13 -> real(kind=DP) :: metric_l(1:num_omtr,-nz:nz-1), metric_g(1:num_omtr,-global_nz:global_nz-1) -> -> -> -> -> namelist /physp/ R0_Ln, & ! R0/Lns -> R0_Lt, & ! R0/Lts -> nu, & ! factor for collision freq. in LB model -> Anum, & ! mass number -> Znum, & ! charge number -> fcs, & ! charge-density fraction -> sgn, & ! signs of charge -> tau, & ! T-ratio Ts/T0, T0=reference ion temp. of ranks=1 -> dns1, & ! initial perturbation amplitude -> tau_ad, & ! Ti/Te for ITG-ae, Te/Ti for ETG-ai -> lambda_i, & ! (Debye/rho_tp)^2 -> beta, & ! mu0*ni*Ti/B^2 -> ibprime, & ! flag for finite beta-prime effect on kvd -> vmax, & ! maximum v_para in unit of v_ts -> nx0 ! mode number for the initial perturbation -> -> namelist /rotat/ mach, uprime, gamma_e -> -> namelist /nperi/ n_tht, kymin, m_j, del_c -> namelist /confp/ eps_r, eps_rnew, & -> q_0, s_hat, & -> lprd, mprd, eps_hor, eps_mor, eps_por, & -> rdeps00, rdeps1_0, rdeps1_10, & -> rdeps2_10, rdeps3_10, malpha -> ! namelist /vmecp/ q_0, rad_a, & -> ! R0_unit, r_edge, & -> ! b0b00, alpha_fix -> namelist /vmecp/ s_input, nss, ntheta, nzeta -> -> namelist /igsp/ s_input, mc_type, q_type, nss, ntheta -> -403,404c497,1787 -< ! --- read GKV namelist relating to configurations --- -< call geom_read_nml ---- -> tau(:) = 1.0_DP -> nu(:) = 0.002_DP -> R0_Ln(:) = 2.5_DP -> R0_Lt(:) = 7.5_DP -> -> -> read(inml,nml=physp) -> -> -> do is = 0, ns-1 -> if( R0_Ln(is) /= 0._DP ) then -> eta(is) = R0_Lt(is) / R0_Ln(is) -> else -> eta(is) = 1.d+20 -> end if -> end do -> -> -> write( olog, * ) " # Physical parameters" -> write( olog, * ) "" -> write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) -> write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) -> write( olog, * ) " # eta = ", eta(:) -> write( olog, * ) " # nu = ", nu(:) -> write( olog, * ) " # A-number = ", Anum(:) -> write( olog, * ) " # Z-number = ", Znum(:) -> write( olog, * ) " # fcs = ", fcs(:) -> write( olog, * ) " # sgn = ", sgn(:) -> write( olog, * ) " # tau = ", tau(:) -> write( olog, * ) " # dns1 = ", dns1(:) -> write( olog, * ) " # tau_ad = ", tau_ad -> write( olog, * ) " # lambda_i^2 = ", lambda_i -> write( olog, * ) " # beta_i = ", beta -> write( olog, * ) " # ibprime = ", ibprime -> write( olog, * ) " # nx0 = ", nx0 -> write( olog, * ) "" -> -> -> mach = 0._DP -> uprime = 0._DP -> gamma_e = 0._DP -> -> read(inml,nml=rotat) -> -> write( olog, * ) " # Mean rotation parameters" -> write( olog, * ) "" -> write( olog, * ) " # Mach number = ", mach -> write( olog, * ) " # uptime = ", uprime -> write( olog, * ) " # gamma_ExB = ", gamma_e -> write( olog, * ) "" -> -> -> n_tht = 1 -> -> read(inml,nml=nperi) -> -> -> if( trim(equib_type) == "slab") then -> -> read(inml,nml=confp) -> -> lprdm1 = 0._DP -> lprdp1 = 0._DP -> -> lmmq = 0._DP -> lmmqm1 = 0._DP -> lmmqp1 = 0._DP -> -> q_0 = 1._DP ! For now, fixed q_0=1. Changing q_0 can extend parallel z-box size. -> s_hat = 0._DP ! only shear less slab -> eps_r = 1._DP -> -> eps_hor = 0._DP -> lprd = 0._DP -> mprd = 0._DP -> malpha = 0._DP -> -> rdeps00 = 0._DP -> eps_mor = 0._DP -> eps_por = 0._DP -> -> write( olog, * ) " # Configuration parameters" -> write( olog, * ) "" -> write( olog, * ) " # q_0 = ", q_0 -> write( olog, * ) " # s_hat = ", s_hat -> write( olog, * ) " # eps_r = ", eps_r -> write( olog, * ) "" -> -> write( olog, * ) " # eps_hor = ", eps_hor -> write( olog, * ) " # lprd = ", lprd -> write( olog, * ) " # mprd = ", mprd -> write( olog, * ) " # malpha = ", malpha -> write( olog, * ) " # rdeps00 = ", rdeps00 -> -> write( olog, * ) " # eps_mor = ", eps_mor -> write( olog, * ) " # lprdm1 = ", lprdm1 -> write( olog, * ) " # eps_por = ", eps_por -> write( olog, * ) " # lprdp1 = ", lprdp1 -> write( olog, * ) "" -> -> else if( trim(equib_type) == "analytic" .OR. & -> trim(equib_type) == "s-alpha" .OR. & -> trim(equib_type) == "s-alpha-shift" .OR. & -> trim(equib_type) == "circ-MHD" ) then -> -> -> read(inml,nml=confp) -> -> -> lprdm1 = lprd - 1.0_DP -> lprdp1 = lprd + 1.0_DP -> -> lmmq = lprd - mprd * q_0 -> lmmqm1 = lprdm1 - mprd * q_0 -> lmmqp1 = lprdp1 - mprd * q_0 -> -> -> write( olog, * ) " # Configuration parameters" -> write( olog, * ) "" -> write( olog, * ) " # q_0 = ", q_0 -> write( olog, * ) " # s_hat = ", s_hat -> write( olog, * ) " # eps_r = ", eps_r -> write( olog, * ) "" -> -> write( olog, * ) " # eps_hor = ", eps_hor -> write( olog, * ) " # lprd = ", lprd -> write( olog, * ) " # mprd = ", mprd -> write( olog, * ) " # malpha = ", malpha -> write( olog, * ) " # rdeps00 = ", rdeps00 -> -> write( olog, * ) " # eps_mor = ", eps_mor -> write( olog, * ) " # lprdm1 = ", lprdm1 -> write( olog, * ) " # eps_por = ", eps_por -> write( olog, * ) " # lprdp1 = ", lprdp1 -> write( olog, * ) "" -> -> -> -> ! else if( trim(equib_type) == "vmec" ) then -> ! -> ! -> !! --- Paramters at rho=0.65 (shot#088343 at t = 1.833 [s]) -> !! -> !! Ln_unit =-4.230701_DP ! Ln [m] -> !! Lt_unit = 0.3135611_DP ! Lt [m] -> !! R0_unit = 3.599858_DP ! R0 [m] -> !! r_edge = 0.6362872D0 ! r_edge [m] -> !! b0b00 = 2.88846853946973647d0/2.940307D0 ! b00mode/B0 -> !! alpha_fix = 0.314159253589793d0 ! pi/10 -> !! -> ! -> ! read(inml,nml=vmecp) -> ! -> ! eps_b = r_edge / R0_unit ! --- a / R ! by nunami (2010.04.21) -> ! -> ! rho2R_0 = eps_b / rad_a ! --- rho / R_0 -> ! rho_unit = rho2R_0 * R0_unit ! --- rho -> ! r_a = rad_a * rho2R_0 ! --- rad_a / R_0 -> ! -> ! eps_r = 0.1115200537d0 -> ! -> ! call vmecin_fileopen -> ! -> ! -> ! call vmecin_read -> ! -> ! -> ! q_input = q_0 -> ! theta = 0._DP -> ! -> ! call vmecin_coeff( rad_a, R0_unit, rho2R_0, q_input, theta, & -> ! alpha_fix, r_0, r_minor, s_hat, & -> ! gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & -> ! gupss, guptt, gupzz, gupst, gupsz, guptz, & -> ! babs, Bs, Bth, Bzt, dBds, dBdt, dBdz, & -> ! dBdt_mir, vmec_rootg, rootgft, rootgbz ) -> ! -> ! -> ! write( olog, * ) " # Configuration parameters" -> ! write( olog, * ) "" -> ! write( olog, * ) " # q_0 = ", q_0 -> ! write( olog, * ) " # s_hat = ", s_hat -> ! write( olog, * ) "" -> ! write( olog, * ) " # eps_r = ", eps_r -> ! write( olog, * ) "" -> -> -> else if( trim(equib_type) == "vmec" ) then -> -> -> read(inml,nml=confp) -> -> read(inml,nml=vmecp) -> -> call vmecbzx_boozx_read( nss, ntheta, nzeta ) -> -> isw = 0 -> iz = 0 -> call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, 0._DP, lz_l, & ! input -> s_0, q_0, s_hat, eps_r, phi_ax, & ! output -> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & -> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & -> gg(2,3), gg(3,3) ) -> -> -> -> write( olog, * ) " # Configuration parameters" -> write( olog, * ) "" -> write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) -> write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) -> write( olog, * ) " # eta = ", eta(:) -> write( olog, * ) " # q_0 = ", q_0 -> write( olog, * ) " # s_hat = ", s_hat -> write( olog, * ) " # eps_r = ", eps_r -> write( olog, * ) " # s_input, s_0 = ", s_input, s_0 -> write( olog, * ) " # nss, ntheta, nzeta = ", nss, ntheta, nzeta -> -> -> else if( trim(equib_type) == "eqdsk" ) then -> -> -> read(inml,nml=confp) -> -> read(inml,nml=igsp) -> -> call igs_read( mc_type, nss, ntheta ) -> -> if ( q_type == 1 ) then -> isw = 0 -> iz = 0 -> call igs_coeff( isw, mc_type, nss, ntheta, s_input, 0._DP, lz_l, & ! input -> s_0, q_0, s_hat, eps_r, theta, & ! output -> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & -> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & -> gg(2,3), gg(3,3) ) -> end if -> -> -> -> write( olog, * ) " # Configuration parameters" -> write( olog, * ) "" -> write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) -> write( olog, * ) " # r_major/L_ts = ", R0_Lt(:) -> write( olog, * ) " # eta = ", eta(:) -> write( olog, * ) " # q_0 = ", q_0 -> write( olog, * ) " # s_hat = ", s_hat -> write( olog, * ) " # eps_r = ", eps_r -> write( olog, * ) " # s_input, s_0 = ", s_input, s_0 -> write( olog, * ) " # nss, ntheta = ", nss, ntheta -> -> else -> -> write( olog, * ) " # wrong choice of the equilibrium " -> call flush(olog) -> call MPI_Finalize(ierr_mpi) -> stop -> -> end if -> -> -> ! --- coordinate settings --- -> -> if (abs(s_hat) < 1.d-10) then ! When s_hat == ZERO -> m_j = 0 -> kxmin = kymin -> else if (m_j == 0) then -> kxmin = kymin -> else -> kxmin = abs(2._DP * pi * s_hat * kymin / real(m_j, kind=DP)) -> end if -> lx = pi / kxmin -> ly = pi / kymin -> ! kymin=pi/ly=pi/[r_minor*pi/(q0*n_alp)]=q0*n_alp/r_minor -> -> lz = real( n_tht, kind=DP ) * pi ! total z-length -> lz_l = lz / real( nprocz, kind=DP ) ! local z-length -> -> do mx = -nx, nx -> kx(mx) = kxmin * real( mx, kind=DP ) -> end do -> -> ky(:) = 0._DP -> do my = ist_y_g, iend_y_g -> ky(my-ist_y_g) = kymin * real( my, kind=DP ) -> end do -> -> kxmin_g = kxmin -> kymin_g = kymin -> -> z0 = - lz ! global lower boundary -> z0_l = 2._DP * lz_l * real( rankz, kind=DP ) + z0 -> ! local lower boundary -> -> dz = lz_l / real( nz, kind=DP ) -> -> do iz = -nz, nz-1 -> zz(iz) = dz * real( iz + nz, kind=DP ) + z0_l -> end do -> -> -> dv = 2._DP * vmax / real( 2 * nv * nprocv -1, kind=DP ) -> -> do iv = 1, 2*nv -> global_iv = 2 * nv * rankv + iv -> vl(iv) = dv * ( real( global_iv - nv * nprocv - 1, kind=DP ) + 0.5_DP ) -> end do -> ! --- debug -> ! write( olog, * ) " *** iv, vl " -> ! do iv = 1, 2*nv -> ! global_iv = 2 * nv * rankv + iv -> ! write( olog, * ) iv, global_iv, vl(iv) -> ! end do -> ! write( olog, * ) "" -> -> mmax = vmax -> dm = mmax / real( nprocm * ( nm+1 ) - 1, kind=DP ) -> ! --- equal spacing in vperp -> -> do im = 0, nm -> global_im = ( nm+1 ) * rankm + im -> mu(im) = 0.5_DP * ( dm * real( global_im, kind=DP ) )**2 -> end do -> -> -> write( olog, * ) " # Numerical parameters" -> write( olog, * ) "" -> write( olog, * ) " # n_tht = ", n_tht -> write( olog, * ) " # lx, ly, lz = ", lx, ly, lz -> write( olog, * ) " # lz, z0 = ", lz, z0 -> write( olog, * ) " # lz_l, z0_l = ", lz_l, z0_l -> write( olog, * ) " # kxmin, kymin = ", kxmin, kymin -> write( olog, * ) " # kxmax, kymax = ", kxmin*nx, kymin*global_ny -> write( olog, * ) " # kperp_max = ", sqrt((kxmin*nx)**2+(kymin*global_ny)**2) -> write( olog, * ) " # m_j, del_c = ", m_j, del_c -> write( olog, * ) " # dz = ", dz -> write( olog, * ) " # dv, vmax = ", dv, vmax -> write( olog, * ) " # dm, mmax = ", dm, mmax -> write( olog, * ) "" -> -> if (gamma_e == 0._DP) then -> tlim_exb = 999999.d0 -> else -> tlim_exb = (kxmin*(nx-nx0))/(kymin*global_ny*abs(gamma_e)) -> end if -> write( olog, * ) " # ExB limit time tlim_exb = ", tlim_exb -> write( olog, * ) " # for (mx=nx0,my=global_ny) initial perturbation: " -> write( olog, * ) " # tlim_exb = kxmin*(nx-nx0)/(kymax*|gamma_e|)" -> write( olog, * ) "" -> -> -> ! --- coordinate settings --- -> -> -> ! --- operator settings --- -> -> -> do iz = -nz, nz-1 -> -> !!! for slab model -> if ( trim(equib_type) == "slab") then -> -> q_bar = q_0 -> r_major = 1._DP ! in the R0 unit -> theta = zz(iz) -> -> omg(iz) = 1._DP -> rootg(iz) = q_0*r_major -> dpara(iz) = dz * q_0 * r_major -> -> do im = 0, nm -> vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) -> mir(iz,im) = 0._DP -> do iv = 1, 2*nv -> vdx(iz,iv,im) = 0._DP -> vdy(iz,iv,im) = 0._DP -> vsy(iz,iv,im) = & -> - sgn(ranks) * tau(ranks) / Znum(ranks) & -> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> + omg(iz)*mu(im) - 1.5_DP ) ) -> end do -> end do ! im loop ends -> -> ksq(:,:,iz) = 0._DP -> do my = ist_y, iend_y -> do mx = -nx, nx -> ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 -> end do -> end do -> -> baxfactor = 1._DP -> -> !- for OUTPUT hst/*.mtr.* - -> domgdz = 0._DP -> domgdy = 0._DP -> domgdx = 0._DP -> gg(1,1) = 1._DP -> gg(1,2) = 0._DP -> gg(1,3) = 0._DP -> gg(2,1) = gg(1,2) -> gg(2,2) = 1._DP -> gg(2,3) = 0._DP -> gg(3,1) = gg(1,3) -> gg(3,2) = gg(2,3) -> gg(3,3) = 1._DP -> metric_l( 1,iz) = zz(iz) ! [ 1] -> metric_l( 2,iz) = theta ! [ 2] -> metric_l( 3,iz) = omg(iz) ! [ 3] -> metric_l( 4,iz) = domgdx ! [ 4] -> metric_l( 5,iz) = domgdy ! [ 5] -> metric_l( 6,iz) = domgdz ! [ 6] -> metric_l( 7,iz) = gg(1,1) ! [ 7] -> metric_l( 8,iz) = gg(1,2) ! [ 8] -> metric_l( 9,iz) = gg(1,3) ! [ 9] -> metric_l(10,iz) = gg(2,2) ! [10] -> metric_l(11,iz) = gg(2,3) ! [11] -> metric_l(12,iz) = gg(3,3) ! [12] -> metric_l(13,iz) = rootg(iz)! [13] -> !------------------------- -> -> -> !!! for the concentric and large-aspect-ratio model !!! -> else if( trim(equib_type) == "analytic" ) then -> -> q_bar = q_0 -> r_major = 1._DP ! in the R0 unit -> -> theta = zz(iz) -> -> omg(iz) = 1._DP & -> - eps_r * ( cos( zz(iz) ) & -> + eps_hor * cos( lmmq * zz(iz) - malpha ) & -> + eps_mor * cos( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * cos( lmmqp1 * zz(iz) - malpha ) ) -> -> rootg(iz) = q_0*r_major/omg(iz) -> dpara(iz) = dz * q_0 * r_major -> -> ! --- debug -> ! write( olog, * ) " *** z, omg " -> ! do iz = -nz, nz-1 -> ! write( olog, * ) zz(iz), omg(iz) -> ! end do -> ! write( olog, * ) -> -> do im = 0, nm -> -> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -> mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & -> * ( sin(zz(iz)) & -> + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & -> + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) -> -> do iv = 1, 2*nv -> !do my = ist_y, iend_y -> ! do mx = -nx, nx -> ! kvd and kvs are revised November 2011 -> ! into general species forms. -> !!!!kvd(mx,my,iz,iv,im)= & -> !!!! - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & -> !!!! * ( ky(my) * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & -> !!!! + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & -> !!!! + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & -> !!!! + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & -> !!!! + ( kx(mx) + s_hat * zz(iz) * ky(my) ) & -> !!!! * ( sin( zz(iz) ) & -> !!!! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & -> !!!! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> !!!! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & -> !!!! ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> !!!!kvs(mx,my,iz,iv,im) = & -> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & -> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) -> -> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% -> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% -> vdx(iz,iv,im)= & -> - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & -> * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & -> + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & -> + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & -> + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & -> + ( 1._DP + s_hat * zz(iz) * 0._DP ) & -> * ( sin( zz(iz) ) & -> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & -> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & -> ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vdy(iz,iv,im)= & -> - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & -> * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & -> + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & -> + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & -> + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & -> + ( 0._DP + s_hat * zz(iz) * 1._DP ) & -> * ( sin( zz(iz) ) & -> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & -> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & -> ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vsy(iz,iv,im) = & -> - sgn(ranks) * tau(ranks) / Znum(ranks) & -> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> + omg(iz)*mu(im) - 1.5_DP ) ) -> -> ! end do -> !end do -> end do -> -> end do ! im loop ends -> -> -> ksq(:,:,iz) = 0._DP -> do my = ist_y, iend_y -> do mx = -nx, nx -> ksq(mx,my,iz) = ( kx(mx) + s_hat * zz(iz) * ky(my) )**2 + ky(my)**2 -> end do -> end do -> -> baxfactor = 1._DP -> -> !- for OUTPUT hst/*.mtr.* - !%%% under benchmark %%% -> domgdz = eps_r * ( sin(zz(iz)) & -> + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & -> + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) -> domgdy = - eps_rnew / r_major * ( & -> - ( sin( zz(iz) ) & -> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & -> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) & -> ) - (-1._DP/eps_r) * domgdz ) -> domgdx = eps_rnew / r_major * ( & -> - ( & -> rdeps00 & -> + rdeps1_0 * cos( zz(iz) ) & -> + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & -> + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & -> + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) & -> + s_hat * zz(iz) * ( sin( zz(iz) ) & -> + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & -> + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & -> + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & -> ) - (-s_hat*zz(iz)/eps_r) * domgdz ) -> gg(1,1) = 1._DP -> gg(1,2) = s_hat*zz(iz) -> gg(1,3) = 0._DP -> gg(2,1) = gg(1,2) -> gg(2,2) = 1._DP + (s_hat*zz(iz))**2 -> gg(2,3) = 1._DP/(r_major*eps_r) -> gg(3,1) = gg(1,3) -> gg(3,2) = gg(2,3) -> gg(3,3) = 1._DP/((r_major*eps_r)**2) -> metric_l( 1,iz) = zz(iz) ! [ 1] -> metric_l( 2,iz) = theta ! [ 2] -> metric_l( 3,iz) = omg(iz) ! [ 3] -> metric_l( 4,iz) = domgdx ! [ 4] -> metric_l( 5,iz) = domgdy ! [ 5] -> metric_l( 6,iz) = domgdz ! [ 6] -> metric_l( 7,iz) = gg(1,1) ! [ 7] -> metric_l( 8,iz) = gg(1,2) ! [ 8] -> metric_l( 9,iz) = gg(1,3) ! [ 9] -> metric_l(10,iz) = gg(2,2) ! [10] -> metric_l(11,iz) = gg(2,3) ! [11] -> metric_l(12,iz) = gg(3,3) ! [12] -> metric_l(13,iz) = rootg(iz)! [13] -> !------------------------- -> -> !!! for s-alpha !!! <--- the current version is the same as "analytic" -> else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then -> -> q_bar = q_0 -> r_major = 1._DP ! in the R0 unit -> -> if (trim(equib_type) == "s-alpha") then -> !--- s-alpha model without Shafranov shift - -> alpha_MHD = 0._DP -> else if (trim(equib_type) == "s-alpha-shift") then -> !--- s-alpha model with Shafranov shift ---- -> p_total = 0._DP -> dp_totaldx = 0._DP -> beta_total = 0._DP -> do is = 0, ns-1 -> p_total = p_total + fcs(is) * tau(is) / Znum(is) -> dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) -> beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) -> end do -> alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total -> end if -> -> theta = zz(iz) -> -> omg(iz) = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion -> !omg(iz) = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark -> -> rootg(iz) = q_0*r_major/omg(iz) -> dpara(iz) = dz* q_0 * r_major -> -> domgdz = eps_r * sin( theta ) -> !domgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark -> domgdx = -cos( theta ) / r_major -> domgdy = 0._DP -> -> -> gg(1,1) = 1._DP -> gg(1,2) = s_hat*zz(iz) - alpha_MHD*sin(zz(iz)) ! with Shafranov shift -> gg(1,3) = 0._DP -> gg(2,1) = gg(1,2) -> gg(2,2) = 1._DP + (s_hat*zz(iz) - alpha_MHD*sin(zz(iz)))**2 ! with Shafranov shift -> gg(2,3) = 1._DP/(r_major*eps_r) -> gg(3,1) = gg(1,3) -> gg(3,2) = gg(2,3) -> gg(3,3) = 1._DP/((r_major*eps_r)**2) -> -> kkx = -r_major * (q_0/q_bar) & -> * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz -> kky = r_major * (q_bar/q_0) & -> * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) -> -> do im = 0, nm -> -> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -> -> mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) -> -> do iv = 1, 2*nv -> !do my = ist_y, iend_y -> ! do mx = -nx, nx -> -> !!!!kvd(mx,my,iz,iv,im) = & -> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & -> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & -> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> !!!!kvs(mx,my,iz,iv,im) = & -> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & -> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) & -> !!!! * (q_bar/q_0) -> -> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% -> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% -> vdx(iz,iv,im) = & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & -> * kkx & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vdy(iz,iv,im) = & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & -> * kky & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vsy(iz,iv,im) = & -> - sgn(ranks) * tau(ranks) / Znum(ranks) & -> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> + omg(iz)*mu(im) - 1.5_DP ) ) & -> * (q_bar/q_0) -> -> ! end do -> !end do -> end do -> -> end do ! im loop ends -> -> -> ksq(:,:,iz) = 0._DP -> do my = ist_y, iend_y -> do mx = -nx, nx -> ksq(mx,my,iz) = ( kx(mx) + ( s_hat * zz(iz) - alpha_MHD*sin(zz(iz)) ) & -> * ky(my) )**2 + ky(my)**2 ! with Shafranov shift -> end do -> end do -> -> baxfactor = 1._DP -> -> !- for OUTPUT hst/*.mtr.* - -> metric_l( 1,iz) = zz(iz) ! [ 1] -> metric_l( 2,iz) = theta ! [ 2] -> metric_l( 3,iz) = omg(iz) ! [ 3] -> metric_l( 4,iz) = domgdx ! [ 4] -> metric_l( 5,iz) = domgdy ! [ 5] -> metric_l( 6,iz) = domgdz ! [ 6] -> metric_l( 7,iz) = gg(1,1) ! [ 7] -> metric_l( 8,iz) = gg(1,2) ! [ 8] -> metric_l( 9,iz) = gg(1,3) ! [ 9] -> metric_l(10,iz) = gg(2,2) ! [10] -> metric_l(11,iz) = gg(2,3) ! [11] -> metric_l(12,iz) = gg(3,3) ! [12] -> metric_l(13,iz) = rootg(iz)! [13] -> !------------------------- -> -> -> !!! for circular MHD equilibrium !!! -> else if( trim(equib_type) == "circ-MHD" ) then -> -> q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 -> r_major = 1._DP ! in the R0 unit -> -> theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & -> * tan(zz(iz)/2._DP) ) -> -> omg(iz) = sqrt( q_bar**2 + eps_r**2 ) & -> / ( 1._DP + eps_r*cos( theta ) ) / q_bar -> -> rootg(iz) = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 -> dpara(iz) = dz * omg(iz) * rootg(iz) -> -> -> domgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & -> / ( 1._DP + eps_r * cos( theta ) )**2 & -> / ( 1._DP - eps_r * cos( zz(iz)) ) / q_0 -> -> domgdx = -( cos(theta) & -> - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & -> *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & -> - eps_r*sin(theta)**2/(1._DP-eps_r**2) & -> ) / ((1._DP + eps_r*cos(theta))**2) & -> * sqrt(q_bar**2+eps_r**2) / q_bar / r_major -> -> domgdy = 0._DP -> -> gg(1,1) = (q_0/q_bar)**2 -> gg(1,2) = ( s_hat*zz(iz)*q_0/q_bar - eps_r*sin(zz(iz))/(1._DP-eps_r**2) )*q_0/q_bar -> gg(1,3) = - sin(zz(iz))/(1._DP-eps_r**2)/r_major*q_0/q_bar -> gg(2,1) = gg(1,2) -> gg(2,2) = (s_hat*zz(iz)*q_0/q_bar)**2 - 2._DP*q_0/q_bar*s_hat*zz(iz)*eps_r*sin(zz(iz))/(1._DP-eps_r**2) & -> + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & -> + (eps_r*sin(zz(iz)))**2/(1._DP-eps_r**2)**2 -> gg(2,3) = ( -s_hat*zz(iz)*q_0/q_bar*sin(zz(iz))/(1._DP-eps_r**2) & -> + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & -> + eps_r*(sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & -> ) / r_major -> gg(3,1) = gg(1,3) -> gg(3,2) = gg(2,3) -> gg(3,3) = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & -> + (sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & -> ) / (r_major**2) -> -> kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) -> kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) -> -> do im = 0, nm -> -> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -> -> mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) -> -> do iv = 1, 2*nv -> !do my = ist_y, iend_y -> ! do mx = -nx, nx -> -> !!!!kvd(mx,my,iz,iv,im)= & -> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & -> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> !!!!kvs(mx,my,iz,iv,im) = & -> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & -> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) -> -> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% -> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% -> vdx(iz,iv,im)= & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> * kkx & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vdy(iz,iv,im)= & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> * kky & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vsy(iz,iv,im) = & -> - sgn(ranks) * tau(ranks) / Znum(ranks) & -> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> + omg(iz)*mu(im) - 1.5_DP ) ) -> -> -> ! end do -> !end do -> end do -> -> end do ! im loop ends -> -> -> ksq(:,:,iz) = 0._DP -> do my = ist_y, iend_y -> do mx = -nx, nx -> ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & -> + 2._DP*kx(mx)*ky(my)*gg(1,2) & -> + (ky(my)**2)*gg(2,2) -> end do -> end do -> -> baxfactor = 1._DP -> -> !- for OUTPUT hst/*.mtr.* - -> metric_l( 1,iz) = zz(iz) ! [ 1] -> metric_l( 2,iz) = theta ! [ 2] -> metric_l( 3,iz) = omg(iz) ! [ 3] -> metric_l( 4,iz) = domgdx ! [ 4] -> metric_l( 5,iz) = domgdy ! [ 5] -> metric_l( 6,iz) = domgdz ! [ 6] -> metric_l( 7,iz) = gg(1,1) ! [ 7] -> metric_l( 8,iz) = gg(1,2) ! [ 8] -> metric_l( 9,iz) = gg(1,3) ! [ 9] -> metric_l(10,iz) = gg(2,2) ! [10] -> metric_l(11,iz) = gg(2,3) ! [11] -> metric_l(12,iz) = gg(3,3) ! [12] -> metric_l(13,iz) = rootg(iz)! [13] -> !------------------------- -> -> !!!! for VMEC equilibrium !!! -> ! else if( trim(equib_type) == "vmec" ) then -> ! -> ! q_bar = q_0 -> ! theta = zz(iz) -> ! -> ! call vmecin_coeff( rad_a, R0_unit, rho2R_0, q_input, theta, & -> ! alpha_fix, r_0, r_minor, s_hat, & -> ! gdwss, gdwtt, gdwzz, gdwst, gdwsz, gdwtz, & -> ! gupss, guptt, gupzz, gupst, gupsz, guptz, & -> ! babs, Bs, Bth, Bzt, dBds, dBdt, dBdz, & -> ! dBdt_mir, vmec_rootg, rootgft, rootgbz ) -> ! -> ! omg(iz) = babs -> ! -> ! rootg(iz) = vmec_rootg * R0_unit * R0_unit * R0_unit -> ! dpara(iz) = dz * babs * rootgft * b0b00 -> ! -> ! -> ! -> ! do im = 0, nm -> ! -> ! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -> ! mir(iz,im) = mu(im) * dBdt_mir / babs / rootgft / b0b00 -> ! -> ! do iv = 1, 2*nv -> ! do my = ist_y, iend_y -> ! do mx = -nx, nx -> ! -> ! kvd(mx,my,iz,iv,im) = & -> ! - (( vl(iv)**2 + omg(iz)*mu(im) ) / rootgbz /babs/babs/babs ) & -> ! * ((r_0/q_0) * ky(my) & -> ! * ( ( (Bs/r_a) + Bzt * (q_0/r_0) * s_hat * zz(iz) ) * dBdt & -> ! +( (Bs/r_a) * q_0 - Bth * (q_0/r_0) * s_hat * zz(iz) ) * dBdz & -> ! -( Bth + Bzt * q_0 ) * dBds / r_a ) & -> ! + kx(mx) * ( Bzt * dBdt - Bth * dBdz )) & -> ! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> ! ! --- k*v_d term -> ! -> ! kvs(mx,my,iz,iv,im) = & -> ! - sgn(ranks) * ky(my) & -> ! * ((r_0/q_0) * (Bth + Bzt * q_0) / rootgbz / babs / babs) & -> ! * ( R0_Ln(ranks) & -> ! + R0_Lt(ranks) * (0.5_DP*vl(iv)**2 + omg(iz)*mu(im) - 1.5_DP) ) & -> ! * tau(ranks) / Znum(ranks) -> ! ! --- k*v_* term -> ! end do -> ! end do -> ! end do -> ! -> ! end do ! im loop ends -> ! -> ! -> ! do my = ist_y, iend_y -> ! do mx = -nx, nx -> ! ksq(mx,my,iz) = (r_a * kx(mx))**2 * gupss & -> ! + ky(my)**2 * ( (r_0/q_0)**2 & -> ! * ( gupzz + guptt * q_0 **2 - guptz * 2._DP * q_0 ) & -> ! + 2._DP * s_hat * (r_0/q_0) * zz(iz) * r_a * ( gupst * q_0 - gupsz ) & -> ! + r_a * r_a * gupss * (s_hat**2) * (zz(iz)**2) ) & -> ! + (r_a * kx(mx)) * ky(my) * 2._DP * ( (r_0/q_0) & -> ! * ( gupst * q_0 - gupsz ) + r_a * gupss * s_hat * zz(iz) ) -> ! ! --- squere of k_perp -> ! end do -> ! end do -> ! -> ! baxfactor = b0b00 ! --- For the use in caldlt -> ! -> -> ! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) -> else if( trim(equib_type) == "vmec" ) then -> -> q_bar = q_0 -> isw = 1 -> r_major = 1._DP ! in the R0 unit -> -> call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz(iz), lz_l, & ! input -> s_0, q_0, s_hat, eps_r, phi_ax, & ! output -> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & -> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & -> gg(2,3), gg(3,3) ) -> -> dpara(iz) = dz * omg(iz) * rootg(iz) -> -> kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) -> kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) -> -> do im = 0, nm -> -> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -> -> mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) -> -> do iv = 1, 2*nv -> !do my = ist_y, iend_y -> ! do mx = -nx, nx -> -> !!!!kvd(mx,my,iz,iv,im) = & -> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & -> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & -> !!!! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term -> !!!! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks))*ky(my) ) & -> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> !!!!kvs(mx,my,iz,iv,im) = & -> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & -> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) -> -> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% -> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% -> vdx(iz,iv,im) = & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> * kkx & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> -> vdy(iz,iv,im) = & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> * kky & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & -> - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term -> * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vsy(iz,iv,im) = & -> - sgn(ranks) * tau(ranks) / Znum(ranks) & -> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> + omg(iz)*mu(im) - 1.5_DP ) ) -> -> -> ! end do -> !end do -> end do -> -> end do ! im loop ends -> -> -> ksq(:,:,iz) = 0._DP -> do my = ist_y, iend_y -> do mx = -nx, nx -> ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & -> + 2._DP*kx(mx)*ky(my)*gg(1,2) & -> + (ky(my)**2)*gg(2,2) -> end do -> end do -> -> baxfactor = 1._DP -> -> !- for OUTPUT hst/*.mtr.* - -> metric_l( 1,iz) = zz(iz) ! [ 1] -> metric_l( 2,iz) = phi_ax ! [ 2] Axisymetric toroidal angle -> metric_l( 3,iz) = omg(iz) ! [ 3] -> metric_l( 4,iz) = domgdx ! [ 4] -> metric_l( 5,iz) = domgdy ! [ 5] -> metric_l( 6,iz) = domgdz ! [ 6] -> metric_l( 7,iz) = gg(1,1) ! [ 7] -> metric_l( 8,iz) = gg(1,2) ! [ 8] -> metric_l( 9,iz) = gg(1,3) ! [ 9] -> metric_l(10,iz) = gg(2,2) ! [10] -> metric_l(11,iz) = gg(2,3) ! [11] -> metric_l(12,iz) = gg(3,3) ! [12] -> metric_l(13,iz) = rootg(iz)! [13] -> !------------------------- -> -> -> else if( trim(equib_type) == "eqdsk" ) then -> -> q_bar = q_0 -> isw = 1 -> r_major = 1._DP ! in the R0 unit -> -> call igs_coeff( isw, mc_type, nss, ntheta, s_input, zz(iz), lz_l, & ! input -> s_0, q_0, s_hat, eps_r, theta, & ! output -> omg(iz), rootg(iz), domgdx, domgdz, domgdy, & -> gg(1,1), gg(1,2), gg(1,3), gg(2,2), & -> gg(2,3), gg(3,3) ) -> -> dpara(iz) = dz * omg(iz) * rootg(iz) -> -> kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) -> kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) -> -> do im = 0, nm -> -> vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) -> -> mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) -> -> do iv = 1, 2*nv -> !do my = ist_y, iend_y -> ! do mx = -nx, nx -> -> !!!!kvd(mx,my,iz,iv,im) = & -> !!!! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> !!!! * ( kkx*kx(mx) + kky*ky(my) ) & -> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & -> !!!! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term -> !!!! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks))*ky(my) ) & -> !!!! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> !!!!kvs(mx,my,iz,iv,im) = & -> !!!! - sgn(ranks) * tau(ranks) / Znum(ranks) * ky(my) & -> !!!! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> !!!! + omg(iz)*mu(im) - 1.5_DP ) ) -> -> !%%% kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) %%% -> !%%% kvs = ky(my) * vsy(iz,iv,im) %%% -> vdx(iz,iv,im) = & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> * kkx & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vdy(iz,iv,im) = & -> ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & -> * kky & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & -> - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term -> * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & -> * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) -> -> vsy(iz,iv,im) = & -> - sgn(ranks) * tau(ranks) / Znum(ranks) & -> * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & -> + omg(iz)*mu(im) - 1.5_DP ) ) -> -> -> ! end do -> !end do -> end do -> -> end do ! im loop ends -> -> -> ksq(:,:,iz) = 0._DP -> do my = ist_y, iend_y -> do mx = -nx, nx -> ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & -> + 2._DP*kx(mx)*ky(my)*gg(1,2) & -> + (ky(my)**2)*gg(2,2) -> end do -> end do -> -> baxfactor = 1._DP -> -> !- for OUTPUT hst/*.mtr.* - -> metric_l( 1,iz) = zz(iz) ! [ 1] -> metric_l( 2,iz) = theta ! [ 2] -> metric_l( 3,iz) = omg(iz) ! [ 3] -> metric_l( 4,iz) = domgdx ! [ 4] -> metric_l( 5,iz) = domgdy ! [ 5] -> metric_l( 6,iz) = domgdz ! [ 6] -> metric_l( 7,iz) = gg(1,1) ! [ 7] -> metric_l( 8,iz) = gg(1,2) ! [ 8] -> metric_l( 9,iz) = gg(1,3) ! [ 9] -> metric_l(10,iz) = gg(2,2) ! [10] -> metric_l(11,iz) = gg(2,3) ! [11] -> metric_l(12,iz) = gg(3,3) ! [12] -> metric_l(13,iz) = rootg(iz)! [13] -> !------------------------- -> -> -> else -> -> write( olog, * ) " # wrong choice of the equilibrium " -> call flush(olog) -> call MPI_Finalize(ierr_mpi) -> stop -> -> end if -> -> -> do im = 0, nm -> do my = ist_y, iend_y -> do mx = -nx, nx -> kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & -> * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) -> call math_j0( kmo, j0(mx,my,iz,im) ) -> call math_j1( kmo, j1(mx,my,iz,im) ) -> call math_j2( kmo, j2(mx,my,iz,im) ) -> end do -> end do -> end do -> -> -> do my = ist_y, iend_y -> do mx = -nx, nx -> bb = ksq(mx,my,iz) / omg(iz)**2 & -> * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) -> call math_g0( bb, g0(mx,my,iz) ) -> end do -> end do -> -> -> !!!! debug (Jan 2012) -> ! write( olog, fmt="(1p,10e15.7)" ) & -> ! zz(iz), omg(iz), mir(iz,0), dpara(iz), jcob(iz), & -> ! ksq(1,2,iz), kvs(1,2,iz,1,0), kvd(1,2,iz,1,0), j0(1,2,iz,0), g0(1,2,iz) -> !!!! debug (Jan 2012) -> -> -> end do ! iz loop ends -> -> !- OUTPUT ascii data hst/*.mtr.* - -> call MPI_gather(metric_l(1,-nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & -> metric_g(1,-global_nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & -> 0, zsp_comm_world, ierr_mpi) -> if ( rankg == 0 ) then -> do iz = -global_nz, global_nz-1 -> write( omtr, fmt="(f15.8,SP,256E24.14e3)") metric_g(:,iz) -> end do -> call flush(omtr) -> end if -> !--------------------------------- -> -> ! --- operator settings --- -> -> -> cfsrf = 0._DP -> cfsrf_l = 0._DP -> do iz = -nz, nz-1 -> ! cfsrf_l = cfsrf_l + 1._DP / omg(iz) -> cfsrf_l = cfsrf_l + rootg(iz) -> ! normalization coefficient for -> ! the surface average -> end do -> -> call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & -> MPI_SUM, zsp_comm_world, ierr_mpi ) -> -> -> ! --- debug -> ! write( olog, * ) " *** z, omg " -> ! do iz = -nz, nz-1 -> ! write( olog, * ) zz(iz), omg(iz) -> ! end do -> ! write( olog, * ) -> -> -> if ( vel_rank == 0 ) then -> do iz = -nz, nz-1 -> !dvp(iz) = vp(iz,1) -> dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) -> end do -> end if -> -> call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & -> vel_comm_world, ierr_mpi ) -> -> -> do my = ist_y_g, iend_y_g -> ck(my-ist_y_g) = exp( ui * 2._DP * pi * del_c & -> * real( n_tht * my, kind=DP ) ) -> dj(my-ist_y_g) = - m_j * n_tht * my -> ! del_c = q_0*n_alp-int(q_0*n_alp) -> ! m_j = 2*n_alp*q_d -> end do -> -> -> do im = 0, nm -> do iv = 1, 2*nv -> do iz = -nz, nz-1 -> fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & -> / sqrt( twopi**3 ) -> end do -> end do -> end do -> -> allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) -> -> ! --- GK polarization factor for efield calculation -> fct_poisson(:,:,:) = 0._DP -> fct_e_energy(:,:,:) = 0._DP -> -> ww(:,:,:) = 0._DP -> do iz = -nz, nz-1 -> do my = ist_y, iend_y -> do mx = -nx, nx -> -> if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode -> -> fct_poisson(mx,my,iz) = 0._DP -> fct_e_energy(mx,my,iz) = 0._DP -> -> else -> -> ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) -> do is = 0, ns-1 -> bb = ksq(mx,my,iz) / omg(iz)**2 & -> * tau(is)*Anum(is)/(Znum(is)**2) -> call math_g0( bb, gg0 ) -> ww(mx,my,iz) = ww(mx,my,iz) & -> + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) -> end do -> fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) -> fct_e_energy(mx,my,iz) = ww(mx,my,iz) -> -> end if -> -> end do -> end do -> end do -> -> -> ! --- ZF-factor for adiabatic model -> if ( ns == 1 ) then -> -> ww(:,:,:) = 0._DP -> do iz = -nz, nz-1 -> my = 0 -> do mx = -nx, nx -> ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & -> / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) -> end do -> end do -> -> call intgrl_fsrf ( ww, fctgt ) -> -> if ( rankw == 0 ) then -> fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) -> ! g0(0,0,iz) has no z dependence -> endif -> -> endif -> -> deallocate( ww ) -> -> allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) -> allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) -> wf(:,:,:,:,:) = ( 0._DP, 0._DP ) -> nw(:,:,:) = ( 0._DP, 0._DP ) -> -> ! --- GK polarization factor for mfield calculation -> fct_ampere(:,:,:) = 0._DP -> fct_m_energy(:,:,:) = 0._DP -> -> if ( beta .ne. 0._DP ) then -> -> do im = 0, nm -> do iv = 1, 2*nv -> do iz = -nz, nz-1 -> do my = ist_y, iend_y -> do mx = -nx, nx -> wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & -> * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) -> end do -> end do -> end do -> end do -> end do -> -> call intgrl_v0_moment_ms ( wf, nw ) -> -> do iz = -nz, nz-1 -> do my = ist_y, iend_y -> do mx = -nx, nx -> fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) -> fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta -> end do -> end do -> end do -> -> if ( rankw == 0 ) then -> do iz = -nz, nz-1 -> fct_ampere(0,0,iz) = 0._DP -> fct_m_energy(0,0,iz) = 0._DP -> end do -> end if -> -> end if -> -> deallocate( wf ) -> deallocate( nw ) -406,407d1788 -< ! --- coordinate settings (time-indep.) --- -< call geom_init_kxkyzvm(lx, ly, eps_r) -411a1793,1799 -> !if (trim(time_advnc) == "imp_colli" .or. trim(time_advnc) == "auto_init") then -> if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then -> call colliimp_set_param -> end if -> !!! call colliimp_set_param -> call dtc_init( lx, ly, vmax ) -> -441,451d1828 -< ! --- coordinate settings (explicitly time-dependent metrics) --- -< call geom_init_metric -< -< ! --- operator settings (time-dependent through metrics) --- -< call geom_set_operators -< if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then -< call colliimp_set_param -< end if -< -< ! --- initial estimate of time steps --- -< call dtc_init( lx, ly, vmax ) -594,602d1970 -< -< !%%% For shearflow rotating flux tube model %%% -< if (gamma_e /= 0._DP .and. trim(flag_shearflow) =="rotating") then -< call geom_reset_time(time) -< if (trim(col_type) == "full" .or. trim(col_type) == "lorentz" .or. trim(time_advnc) == "imp_colli") then -< call colliimp_set_param -< end if -< end if -< !%%% diff --git a/run/gkvp_namelist b/run/gkvp_namelist index b28deb4..c056c03 100644 --- a/run/gkvp_namelist +++ b/run/gkvp_namelist @@ -42,7 +42,7 @@ nx0 = 0, &end &rotat mach = 0.d0, uprime = 0.d0, - gamma_e = 0.2d0, &end + gamma_e = 0.d0, &end &nperi n_tht = 1, kymin = 0.5d0, m_j = 1, @@ -63,6 +63,9 @@ rdeps3_10= 0.d0, malpha = 0.d0, &end + &ring ring_a = 0.5d0, + kxmin = 0.05d0, &end + &vmecp s_input = 0.5d0, nss = 501, ntheta = 384, diff --git a/src/gkvp_dtc.f90 b/src/gkvp_dtc.f90 index 5b4cb8b..1aad21a 100644 --- a/src/gkvp_dtc.f90 +++ b/src/gkvp_dtc.f90 @@ -70,8 +70,8 @@ SUBROUTINE dtc_init( lx, ly, vmax ) do mx = -nx, nx ! do mx = 0, nx kvd = kx(mx) * vdx(iz,iv,im) + ky(my) * vdy(iz,iv,im) - if ( kvd_max < kvd ) then - kvd_max = kvd + if ( kvd_max < abs(kvd) ) then + kvd_max = abs(kvd) end if end do end do diff --git a/src/gkvp_geom.f90 b/src/gkvp_geom.f90 index b4462cc..f450d8e 100644 --- a/src/gkvp_geom.f90 +++ b/src/gkvp_geom.f90 @@ -23,6 +23,9 @@ MODULE GKV_geom use GKV_vmecbzx, only: vmecbzx_boozx_read, vmecbzx_boozx_coeff ! for tokamak(eqdsk) equilibrium use GKV_igs, only: igs_read, igs_coeff + !sakano_ring-dipole st 202303 + use GKV_ring, only: ring_coordinates + !sakano_ring-dipole end 202303 implicit none @@ -38,7 +41,7 @@ MODULE GKV_geom ! Metrics in GKV coordinates (x,y,z) ! Metrics in flux coordinates (r,t,q)=(rho,theta,zeta) real(kind=DP), dimension(-global_nz:global_nz-1) :: zz ! The rotating flux tube coordinate (= z'') - real(kind=DP), dimension(-global_nz:global_nz-1) :: theta ! The geometrical poloidal angle theta_pol, not the flux-coordinate theta + real(kind=DP), dimension(-global_nz:global_nz-1) :: theta ! The poloidal angle theta_pol, not the flux-coordinate theta real(kind=DP), dimension(-global_nz:global_nz-1) :: omg ! Magnetic field strength real(kind=DP), dimension(-global_nz:global_nz-1) :: & domgdx, domgdy, domgdz, gxx, gxy, gxz, gyy, gyz, gzz, rootg_xyz @@ -97,7 +100,7 @@ MODULE GKV_geom real(kind=DP) :: r_major integer, parameter :: num_omtr = 13 - real(kind=DP) :: metric_l(1:num_omtr,-nz:nz-1), metric_g(1:num_omtr,-global_nz:global_nz-1) +! real(kind=DP) :: metric_l(1:num_omtr,-nz:nz-1), metric_g(1:num_omtr,-global_nz:global_nz-1) real(kind=DP) :: s_hat @@ -117,6 +120,10 @@ MODULE GKV_geom integer :: isw, nss, ntheta, nzeta real(kind=DP) :: phi_ax ! axisymmetric toroidal angle +!sakano_ring-dipole st 202303 + real(kind=DP) :: ring_a +!sakano_ring-dipole end 202303 + real(kind=DP) :: lz_l @@ -165,6 +172,9 @@ SUBROUTINE geom_read_nml namelist /vmecp/ s_input, nss, ntheta, nzeta namelist /igsp/ s_input, mc_type, q_type, nss, ntheta +!sakano_ring-dipole st 202303 + namelist /ring/ ring_a, kxmin +!sakano_ring-dipole end 202303 tau(:) = 1.0_DP nu(:) = 0.002_DP @@ -320,8 +330,6 @@ SUBROUTINE geom_read_nml gg(1,1), gg(1,2), gg(1,3), gg(2,2), & gg(2,3), gg(3,3) ) - - write( olog, * ) " # Configuration parameters" write( olog, * ) "" write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) @@ -353,8 +361,6 @@ SUBROUTINE geom_read_nml gg(2,3), gg(3,3) ) end if - - write( olog, * ) " # Configuration parameters" write( olog, * ) "" write( olog, * ) " # r_major/L_ns = ", R0_Ln(:) @@ -366,6 +372,24 @@ SUBROUTINE geom_read_nml write( olog, * ) " # s_input, s_0 = ", s_input, s_0 write( olog, * ) " # nss, ntheta = ", nss, ntheta +!sakano_ring-dipole st 202303 + else if ( trim(equib_type) == "ring" ) then + + read(inml,nml=confp) + + read(inml,nml=ring) + + s_hat = 0._DP + + write( olog, * ) " # Configuration parameters for ring dipole configuration" + write( olog, * ) "" + write( olog, * ) " # s_hat = ", s_hat + write( olog, * ) " # kxmin = ", kxmin + write( olog, * ) " # ring_a = ", ring_a + write( olog, * ) " # eps_r = ", eps_r + write( olog, * ) " # q_0 = ", q_0 +!sakano_ring-dipole end 202303 + else write( olog, * ) " # wrong choice of the equilibrium " @@ -384,17 +408,19 @@ SUBROUTINE geom_init_kxkyzvm(lx, ly, eps_r_temp) implicit none real(kind=DP), intent(out) :: lx, ly, eps_r_temp integer :: global_iv, global_im - integer :: mx, my, iz, iv, im, is, ierr_mpi + integer :: mx, my, iz, iv, im eps_r_temp = eps_r - if (abs(s_hat) < 1.d-10) then ! When s_hat == ZERO - m_j = 0 - kxmin = kymin - else if (m_j == 0) then - kxmin = kymin - else - kxmin = abs(2._DP * pi * s_hat * kymin / real(m_j, kind=DP)) + if ( trim(equib_type) /= "ring" ) then + if (abs(s_hat) < 1.d-10) then ! When s_hat == ZERO + m_j = 0 + kxmin = kymin + else if (m_j == 0) then + kxmin = kymin + else + kxmin = abs(2._DP * pi * s_hat * kymin / real(m_j, kind=DP)) + end if end if lx = pi / kxmin ly = pi / kymin @@ -487,324 +513,324 @@ SUBROUTINE geom_init_kxkyzvm(lx, ly, eps_r_temp) END SUBROUTINE geom_init_kxkyzvm -!-------------------------------------- - SUBROUTINE geom_init_metric_old -!-------------------------------------- - implicit none - real(kind=DP) :: theta, domgdz, domgdx, domgdy - real(kind=DP), dimension(1:3,1:3) :: gg - - integer :: iz, is - - - do iz = -nz, nz-1 - -!!! for slab model - if ( trim(equib_type) == "slab") then - - q_bar = q_0 - r_major = 1._DP ! in the R0 unit - theta = zz(iz) - - omg(iz) = 1._DP - rootg(iz) = q_0*r_major - - !- for OUTPUT hst/*.mtr.* - - domgdz = 0._DP - domgdy = 0._DP - domgdx = 0._DP - gg(1,1) = 1._DP - gg(1,2) = 0._DP - gg(1,3) = 0._DP - gg(2,1) = gg(1,2) - gg(2,2) = 1._DP - gg(2,3) = 0._DP - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = 1._DP - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - -!!! for the concentric and large-aspect-ratio model !!! - else if( trim(equib_type) == "analytic" ) then - - q_bar = q_0 - r_major = 1._DP ! in the R0 unit - - theta = zz(iz) - - omg(iz) = 1._DP & - - eps_r * ( cos( zz(iz) ) & - + eps_hor * cos( lmmq * zz(iz) - malpha ) & - + eps_mor * cos( lmmqm1 * zz(iz) - malpha ) & - + eps_por * cos( lmmqp1 * zz(iz) - malpha ) ) - - rootg(iz) = q_0*r_major/omg(iz) - - !- for OUTPUT hst/*.mtr.* - !%%% under benchmark %%% - domgdz = eps_r * ( sin(zz(iz)) & - + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) - domgdy = - eps_rnew / r_major * ( & - - ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) & - ) - (-1._DP/eps_r) * domgdz ) - domgdx = eps_rnew / r_major * ( & - - ( & - rdeps00 & - + rdeps1_0 * cos( zz(iz) ) & - + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) & - + s_hat * zz(iz) * ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - ) - (-s_hat*zz(iz)/eps_r) * domgdz ) - gg(1,1) = 1._DP - gg(1,2) = s_hat*zz(iz) - gg(1,3) = 0._DP - gg(2,1) = gg(1,2) - gg(2,2) = 1._DP + (s_hat*zz(iz))**2 - gg(2,3) = 1._DP/(r_major*eps_r) - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = 1._DP/((r_major*eps_r)**2) - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - -!!! for s-alpha !!! <--- the current version is the same as "analytic" - else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then - - q_bar = q_0 - r_major = 1._DP ! in the R0 unit - - if (trim(equib_type) == "s-alpha") then - !--- s-alpha model without Shafranov shift - - alpha_MHD = 0._DP - else if (trim(equib_type) == "s-alpha-shift") then - !--- s-alpha model with Shafranov shift ---- - p_total = 0._DP - dp_totaldx = 0._DP - beta_total = 0._DP - do is = 0, ns-1 - p_total = p_total + fcs(is) * tau(is) / Znum(is) - dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) - beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) - end do - alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total - end if - - theta = zz(iz) - - omg(iz) = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion - !omg(iz) = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark - - rootg(iz) = q_0*r_major/omg(iz) - - domgdz = eps_r * sin( theta ) - !domgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark - domgdx = -cos( theta ) / r_major - domgdy = 0._DP - - gg(1,1) = 1._DP - gg(1,2) = s_hat*zz(iz) - alpha_MHD*sin(zz(iz)) ! with Shafranov shift - gg(1,3) = 0._DP - gg(2,1) = gg(1,2) - gg(2,2) = 1._DP + (s_hat*zz(iz) - alpha_MHD*sin(zz(iz)))**2 ! with Shafranov shift - gg(2,3) = 1._DP/(r_major*eps_r) - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = 1._DP/((r_major*eps_r)**2) - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - -!!! for circular MHD equilibrium !!! - else if( trim(equib_type) == "circ-MHD" ) then - - q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 - r_major = 1._DP ! in the R0 unit - - theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & - * tan(zz(iz)/2._DP) ) - - omg(iz) = sqrt( q_bar**2 + eps_r**2 ) & - / ( 1._DP + eps_r*cos( theta ) ) / q_bar - - rootg(iz) = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 - - domgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & - / ( 1._DP + eps_r * cos( theta ) )**2 & - / ( 1._DP - eps_r * cos( zz(iz)) ) / q_0 - - domgdx = -( cos(theta) & - - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & - *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & - - eps_r*sin(theta)**2/(1._DP-eps_r**2) & - ) / ((1._DP + eps_r*cos(theta))**2) & - * sqrt(q_bar**2+eps_r**2) / q_bar / r_major - - domgdy = 0._DP - - gg(1,1) = (q_0/q_bar)**2 - gg(1,2) = ( s_hat*zz(iz)*q_0/q_bar - eps_r*sin(zz(iz))/(1._DP-eps_r**2) )*q_0/q_bar - gg(1,3) = - sin(zz(iz))/(1._DP-eps_r**2)/r_major*q_0/q_bar - gg(2,1) = gg(1,2) - gg(2,2) = (s_hat*zz(iz)*q_0/q_bar)**2 - 2._DP*q_0/q_bar*s_hat*zz(iz)*eps_r*sin(zz(iz))/(1._DP-eps_r**2) & - + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & - + (eps_r*sin(zz(iz)))**2/(1._DP-eps_r**2)**2 - gg(2,3) = ( -s_hat*zz(iz)*q_0/q_bar*sin(zz(iz))/(1._DP-eps_r**2) & - + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & - + eps_r*(sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & - ) / r_major - gg(3,1) = gg(1,3) - gg(3,2) = gg(2,3) - gg(3,3) = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & - + (sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & - ) / (r_major**2) - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - -! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) - else if( trim(equib_type) == "vmec" ) then - - q_bar = q_0 - isw = 1 - r_major = 1._DP ! in the R0 unit - - call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz(iz), lz_l, & ! input - s_0, q_0, s_hat, eps_r, phi_ax, & ! output - omg(iz), rootg(iz), domgdx, domgdz, domgdy, & - gg(1,1), gg(1,2), gg(1,3), gg(2,2), & - gg(2,3), gg(3,3) ) - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = phi_ax ! [ 2] Axisymetric toroidal angle - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - - else if( trim(equib_type) == "eqdsk" ) then - - q_bar = q_0 - isw = 1 - r_major = 1._DP ! in the R0 unit - - call igs_coeff( isw, mc_type, nss, ntheta, s_input, zz(iz), lz_l, & ! input - s_0, q_0, s_hat, eps_r, theta, & ! output - omg(iz), rootg(iz), domgdx, domgdz, domgdy, & - gg(1,1), gg(1,2), gg(1,3), gg(2,2), & - gg(2,3), gg(3,3) ) - - !- for OUTPUT hst/*.mtr.* - - metric_l( 1,iz) = zz(iz) ! [ 1] - metric_l( 2,iz) = theta ! [ 2] - metric_l( 3,iz) = omg(iz) ! [ 3] - metric_l( 4,iz) = domgdx ! [ 4] - metric_l( 5,iz) = domgdy ! [ 5] - metric_l( 6,iz) = domgdz ! [ 6] - metric_l( 7,iz) = gg(1,1) ! [ 7] - metric_l( 8,iz) = gg(1,2) ! [ 8] - metric_l( 9,iz) = gg(1,3) ! [ 9] - metric_l(10,iz) = gg(2,2) ! [10] - metric_l(11,iz) = gg(2,3) ! [11] - metric_l(12,iz) = gg(3,3) ! [12] - metric_l(13,iz) = rootg(iz)! [13] - !------------------------- - - - else - - write( olog, * ) " # wrong choice of the equilibrium " - call flush(olog) - call MPI_Finalize(ierr_mpi) - stop - - end if - - end do ! iz loop ends - -!- OUTPUT ascii data hst/*.mtr.* - - call MPI_gather(metric_l(1,-nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & - metric_g(1,-global_nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & - 0, zsp_comm_world, ierr_mpi) - if ( rankg == 0 ) then - do iz = -global_nz, global_nz-1 - write( omtr, fmt="(f15.8,SP,256E24.14e3)") metric_g(:,iz) - end do - call flush(omtr) - end if -!--------------------------------- - - END SUBROUTINE geom_init_metric_old +!!-------------------------------------- +! SUBROUTINE geom_init_metric_old +!!-------------------------------------- +! implicit none +! real(kind=DP) :: theta, domgdz, domgdx, domgdy +! real(kind=DP), dimension(1:3,1:3) :: gg +! +! integer :: iz, is +! +! +! do iz = -nz, nz-1 +! +!!!! for slab model +! if ( trim(equib_type) == "slab") then +! +! q_bar = q_0 +! r_major = 1._DP ! in the R0 unit +! theta = zz(iz) +! +! omg(iz) = 1._DP +! rootg(iz) = q_0*r_major +! +! !- for OUTPUT hst/*.mtr.* - +! domgdz = 0._DP +! domgdy = 0._DP +! domgdx = 0._DP +! gg(1,1) = 1._DP +! gg(1,2) = 0._DP +! gg(1,3) = 0._DP +! gg(2,1) = gg(1,2) +! gg(2,2) = 1._DP +! gg(2,3) = 0._DP +! gg(3,1) = gg(1,3) +! gg(3,2) = gg(2,3) +! gg(3,3) = 1._DP +! metric_l( 1,iz) = zz(iz) ! [ 1] +! metric_l( 2,iz) = theta ! [ 2] +! metric_l( 3,iz) = omg(iz) ! [ 3] +! metric_l( 4,iz) = domgdx ! [ 4] +! metric_l( 5,iz) = domgdy ! [ 5] +! metric_l( 6,iz) = domgdz ! [ 6] +! metric_l( 7,iz) = gg(1,1) ! [ 7] +! metric_l( 8,iz) = gg(1,2) ! [ 8] +! metric_l( 9,iz) = gg(1,3) ! [ 9] +! metric_l(10,iz) = gg(2,2) ! [10] +! metric_l(11,iz) = gg(2,3) ! [11] +! metric_l(12,iz) = gg(3,3) ! [12] +! metric_l(13,iz) = rootg(iz)! [13] +! !------------------------- +! +! +!!!! for the concentric and large-aspect-ratio model !!! +! else if( trim(equib_type) == "analytic" ) then +! +! q_bar = q_0 +! r_major = 1._DP ! in the R0 unit +! +! theta = zz(iz) +! +! omg(iz) = 1._DP & +! - eps_r * ( cos( zz(iz) ) & +! + eps_hor * cos( lmmq * zz(iz) - malpha ) & +! + eps_mor * cos( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * cos( lmmqp1 * zz(iz) - malpha ) ) +! +! rootg(iz) = q_0*r_major/omg(iz) +! +! !- for OUTPUT hst/*.mtr.* - !%%% under benchmark %%% +! domgdz = eps_r * ( sin(zz(iz)) & +! + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & +! + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) +! domgdy = - eps_rnew / r_major * ( & +! - ( sin( zz(iz) ) & +! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) & +! ) - (-1._DP/eps_r) * domgdz ) +! domgdx = eps_rnew / r_major * ( & +! - ( & +! rdeps00 & +! + rdeps1_0 * cos( zz(iz) ) & +! + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +! + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +! + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) & +! + s_hat * zz(iz) * ( sin( zz(iz) ) & +! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +! ) - (-s_hat*zz(iz)/eps_r) * domgdz ) +! gg(1,1) = 1._DP +! gg(1,2) = s_hat*zz(iz) +! gg(1,3) = 0._DP +! gg(2,1) = gg(1,2) +! gg(2,2) = 1._DP + (s_hat*zz(iz))**2 +! gg(2,3) = 1._DP/(r_major*eps_r) +! gg(3,1) = gg(1,3) +! gg(3,2) = gg(2,3) +! gg(3,3) = 1._DP/((r_major*eps_r)**2) +! metric_l( 1,iz) = zz(iz) ! [ 1] +! metric_l( 2,iz) = theta ! [ 2] +! metric_l( 3,iz) = omg(iz) ! [ 3] +! metric_l( 4,iz) = domgdx ! [ 4] +! metric_l( 5,iz) = domgdy ! [ 5] +! metric_l( 6,iz) = domgdz ! [ 6] +! metric_l( 7,iz) = gg(1,1) ! [ 7] +! metric_l( 8,iz) = gg(1,2) ! [ 8] +! metric_l( 9,iz) = gg(1,3) ! [ 9] +! metric_l(10,iz) = gg(2,2) ! [10] +! metric_l(11,iz) = gg(2,3) ! [11] +! metric_l(12,iz) = gg(3,3) ! [12] +! metric_l(13,iz) = rootg(iz)! [13] +! !------------------------- +! +!!!! for s-alpha !!! <--- the current version is the same as "analytic" +! else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then +! +! q_bar = q_0 +! r_major = 1._DP ! in the R0 unit +! +! if (trim(equib_type) == "s-alpha") then +! !--- s-alpha model without Shafranov shift - +! alpha_MHD = 0._DP +! else if (trim(equib_type) == "s-alpha-shift") then +! !--- s-alpha model with Shafranov shift ---- +! p_total = 0._DP +! dp_totaldx = 0._DP +! beta_total = 0._DP +! do is = 0, ns-1 +! p_total = p_total + fcs(is) * tau(is) / Znum(is) +! dp_totaldx = dp_totaldx - fcs(is) * tau(is) / Znum(is) * (R0_Ln(is) + R0_Lt(is)) +! beta_total = beta_total + 2._DP * beta * fcs(is) * tau(is) / Znum(is) +! end do +! alpha_MHD = - q_0**2 * r_major * beta_total * dp_totaldx / p_total +! end if +! +! theta = zz(iz) +! +! omg(iz) = 1._DP - eps_r * cos( theta ) ! s-alpha with eps-expansion +! !omg(iz) = 1._DP / (1._DP + eps_r * cos( theta )) ! for benchmark +! +! rootg(iz) = q_0*r_major/omg(iz) +! +! domgdz = eps_r * sin( theta ) +! !domgdz = eps_r * sin( theta ) * omg(iz)**2 ! for benchmark +! domgdx = -cos( theta ) / r_major +! domgdy = 0._DP +! +! gg(1,1) = 1._DP +! gg(1,2) = s_hat*zz(iz) - alpha_MHD*sin(zz(iz)) ! with Shafranov shift +! gg(1,3) = 0._DP +! gg(2,1) = gg(1,2) +! gg(2,2) = 1._DP + (s_hat*zz(iz) - alpha_MHD*sin(zz(iz)))**2 ! with Shafranov shift +! gg(2,3) = 1._DP/(r_major*eps_r) +! gg(3,1) = gg(1,3) +! gg(3,2) = gg(2,3) +! gg(3,3) = 1._DP/((r_major*eps_r)**2) +! +! !- for OUTPUT hst/*.mtr.* - +! metric_l( 1,iz) = zz(iz) ! [ 1] +! metric_l( 2,iz) = theta ! [ 2] +! metric_l( 3,iz) = omg(iz) ! [ 3] +! metric_l( 4,iz) = domgdx ! [ 4] +! metric_l( 5,iz) = domgdy ! [ 5] +! metric_l( 6,iz) = domgdz ! [ 6] +! metric_l( 7,iz) = gg(1,1) ! [ 7] +! metric_l( 8,iz) = gg(1,2) ! [ 8] +! metric_l( 9,iz) = gg(1,3) ! [ 9] +! metric_l(10,iz) = gg(2,2) ! [10] +! metric_l(11,iz) = gg(2,3) ! [11] +! metric_l(12,iz) = gg(3,3) ! [12] +! metric_l(13,iz) = rootg(iz)! [13] +! !------------------------- +! +! +!!!! for circular MHD equilibrium !!! +! else if( trim(equib_type) == "circ-MHD" ) then +! +! q_bar = dsqrt( 1._DP - eps_r**2 )*q_0 +! r_major = 1._DP ! in the R0 unit +! +! theta = 2._DP*atan( sqrt( (1._DP+eps_r)/(1._DP-eps_r) ) & +! * tan(zz(iz)/2._DP) ) +! +! omg(iz) = sqrt( q_bar**2 + eps_r**2 ) & +! / ( 1._DP + eps_r*cos( theta ) ) / q_bar +! +! rootg(iz) = q_0*r_major*( 1._DP+eps_r*cos(theta) )**2 +! +! domgdz = eps_r * sin(theta) * sqrt( q_bar**2 + eps_r**2 ) & +! / ( 1._DP + eps_r * cos( theta ) )**2 & +! / ( 1._DP - eps_r * cos( zz(iz)) ) / q_0 +! +! domgdx = -( cos(theta) & +! - eps_r*(1._DP-s_hat+eps_r**2*q_0**2/q_bar**2) & +! *(1._DP+eps_r*cos(theta))/(q_bar**2+eps_r**2) & +! - eps_r*sin(theta)**2/(1._DP-eps_r**2) & +! ) / ((1._DP + eps_r*cos(theta))**2) & +! * sqrt(q_bar**2+eps_r**2) / q_bar / r_major +! +! domgdy = 0._DP +! +! gg(1,1) = (q_0/q_bar)**2 +! gg(1,2) = ( s_hat*zz(iz)*q_0/q_bar - eps_r*sin(zz(iz))/(1._DP-eps_r**2) )*q_0/q_bar +! gg(1,3) = - sin(zz(iz))/(1._DP-eps_r**2)/r_major*q_0/q_bar +! gg(2,1) = gg(1,2) +! gg(2,2) = (s_hat*zz(iz)*q_0/q_bar)**2 - 2._DP*q_0/q_bar*s_hat*zz(iz)*eps_r*sin(zz(iz))/(1._DP-eps_r**2) & +! + (q_bar**2+eps_r**2)/((1._DP+eps_r*cos(theta))**2)/(q_0**2) & +! + (eps_r*sin(zz(iz)))**2/(1._DP-eps_r**2)**2 +! gg(2,3) = ( -s_hat*zz(iz)*q_0/q_bar*sin(zz(iz))/(1._DP-eps_r**2) & +! + ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/eps_r & +! + eps_r*(sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & +! ) / r_major +! gg(3,1) = gg(1,3) +! gg(3,2) = gg(2,3) +! gg(3,3) = ( ((q_bar/q_0)**2)/((1._DP+eps_r*cos(theta))**2)/(eps_r**2) & +! + (sin(zz(iz))**2)/((1._DP-eps_r**2)**2) & +! ) / (r_major**2) +! +! !- for OUTPUT hst/*.mtr.* - +! metric_l( 1,iz) = zz(iz) ! [ 1] +! metric_l( 2,iz) = theta ! [ 2] +! metric_l( 3,iz) = omg(iz) ! [ 3] +! metric_l( 4,iz) = domgdx ! [ 4] +! metric_l( 5,iz) = domgdy ! [ 5] +! metric_l( 6,iz) = domgdz ! [ 6] +! metric_l( 7,iz) = gg(1,1) ! [ 7] +! metric_l( 8,iz) = gg(1,2) ! [ 8] +! metric_l( 9,iz) = gg(1,3) ! [ 9] +! metric_l(10,iz) = gg(2,2) ! [10] +! metric_l(11,iz) = gg(2,3) ! [11] +! metric_l(12,iz) = gg(3,3) ! [12] +! metric_l(13,iz) = rootg(iz)! [13] +! !------------------------- +! +!! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) +! else if( trim(equib_type) == "vmec" ) then +! +! q_bar = q_0 +! isw = 1 +! r_major = 1._DP ! in the R0 unit +! +! call vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz(iz), lz_l, & ! input +! s_0, q_0, s_hat, eps_r, phi_ax, & ! output +! omg(iz), rootg(iz), domgdx, domgdz, domgdy, & +! gg(1,1), gg(1,2), gg(1,3), gg(2,2), & +! gg(2,3), gg(3,3) ) +! +! !- for OUTPUT hst/*.mtr.* - +! metric_l( 1,iz) = zz(iz) ! [ 1] +! metric_l( 2,iz) = phi_ax ! [ 2] Axisymetric toroidal angle +! metric_l( 3,iz) = omg(iz) ! [ 3] +! metric_l( 4,iz) = domgdx ! [ 4] +! metric_l( 5,iz) = domgdy ! [ 5] +! metric_l( 6,iz) = domgdz ! [ 6] +! metric_l( 7,iz) = gg(1,1) ! [ 7] +! metric_l( 8,iz) = gg(1,2) ! [ 8] +! metric_l( 9,iz) = gg(1,3) ! [ 9] +! metric_l(10,iz) = gg(2,2) ! [10] +! metric_l(11,iz) = gg(2,3) ! [11] +! metric_l(12,iz) = gg(3,3) ! [12] +! metric_l(13,iz) = rootg(iz)! [13] +! !------------------------- +! +! +! else if( trim(equib_type) == "eqdsk" ) then +! +! q_bar = q_0 +! isw = 1 +! r_major = 1._DP ! in the R0 unit +! +! call igs_coeff( isw, mc_type, nss, ntheta, s_input, zz(iz), lz_l, & ! input +! s_0, q_0, s_hat, eps_r, theta, & ! output +! omg(iz), rootg(iz), domgdx, domgdz, domgdy, & +! gg(1,1), gg(1,2), gg(1,3), gg(2,2), & +! gg(2,3), gg(3,3) ) +! +! !- for OUTPUT hst/*.mtr.* - +! metric_l( 1,iz) = zz(iz) ! [ 1] +! metric_l( 2,iz) = theta ! [ 2] +! metric_l( 3,iz) = omg(iz) ! [ 3] +! metric_l( 4,iz) = domgdx ! [ 4] +! metric_l( 5,iz) = domgdy ! [ 5] +! metric_l( 6,iz) = domgdz ! [ 6] +! metric_l( 7,iz) = gg(1,1) ! [ 7] +! metric_l( 8,iz) = gg(1,2) ! [ 8] +! metric_l( 9,iz) = gg(1,3) ! [ 9] +! metric_l(10,iz) = gg(2,2) ! [10] +! metric_l(11,iz) = gg(2,3) ! [11] +! metric_l(12,iz) = gg(3,3) ! [12] +! metric_l(13,iz) = rootg(iz)! [13] +! !------------------------- +! +! +! else +! +! write( olog, * ) " # wrong choice of the equilibrium " +! call flush(olog) +! call MPI_Finalize(ierr_mpi) +! stop +! +! end if +! +! end do ! iz loop ends +! +!!- OUTPUT ascii data hst/*.mtr.* - +! call MPI_gather(metric_l(1,-nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & +! metric_g(1,-global_nz), num_omtr*2*nz, MPI_DOUBLE_PRECISION, & +! 0, zsp_comm_world, ierr_mpi) +! if ( rankg == 0 ) then +! do iz = -global_nz, global_nz-1 +! write( omtr, fmt="(f15.8,SP,256E24.14e3)") metric_g(:,iz) +! end do +! call flush(omtr) +! end if +!!--------------------------------- +! +! END SUBROUTINE geom_init_metric_old !-------------------------------------- @@ -817,9 +843,24 @@ SUBROUTINE geom_init_metric real(kind=DP) :: gdomgdr, gdomgdt, gdomgdq, & ggrr, ggrt, ggrq, ggtt, ggtq, ggqq, grootg_rtq integer :: iz, is +!sakano_ring-dipole st 202303 + real(kind=DP) :: ub_dot_grdb, ub_crs_grdb +!sakano_ring-dipole end 202303 s_hat_g = s_hat + !- zero clear - + gdomgdr = 0._DP + gdomgdt = 0._DP + gdomgdq = 0._DP + ggrr = 1._DP + ggrt = 0._DP + ggrq = 0._DP + ggtt = 1._DP + ggtq = 0._DP + ggqq = 1._DP + grootg_rtq = 1._DP + do iz = -global_nz, global_nz-1 wzz = dz * iz @@ -1136,6 +1177,43 @@ SUBROUTINE geom_init_metric cy = cx*s_0/q_0 cb = 1._DP +!sakano_ring-dipole st 202303 + else if( trim(equib_type) == "ring" ) then + !- Ring dipole geometry - + ! [Ref.] J. Sakano, Master thesis, Nagoya University (in Japanese). + ! + ! Consider flux coordinates (Psi,Theta,phi), where the magnetic + ! poloidal flux Psi<0, the geometrical poloidal angle Theta = arctan(Z/(R-a)), + ! the azimuthal angle of the cylindrical coordinate phi. + ! There is a ring current in direction of phi at R=a. The field line + ! passing through (R,Z)=(R0,0) is picked up as a flux-tube domain. + ! + ! GKV coordinates (x,y,z) are (right-handed system) + ! x = cx*(Psi0 - Psi)/Psi0 + ! y = cy*phi + ! z = Theta + ! with cx=R0, cy=R0. Note that Psi0 is the magnetic poloidal flux + ! at the center of the considered flux-tube domain. + ! In these definitions, the factor on the magnetic field + ! B = cb * \nabla x \times \nabla y is cb = Psi0/(R0*R0) = B0, + ! where B0 is the magnetic field strength at (R,Z)=(R0,0). + ! Normalized omg = B(z)/B0 and cb = 1 in the B0 unit. + ! The reference length is set to be R0 (not the ring current at R=a). + ! The normalized parameter to specify the flux-tube is + ! ring_a = a / R0 + !- + r_major = 1._DP ! in the R0 unit + q_bar = 0._DP + theta = wzz + call ring_coordinates( ring_a, wzz, & ! input + gomg, ub_dot_grdb, ub_crs_grdb, ggxx, ggxy, & ! output + ggxz, ggyy, ggyz, ggzz, grootg_xyz, gdomgdx, gdomgdz ) + gdomgdy = 0._DP + cx = 1._DP + cy = 1._DP + cb = 1._DP +!sakano_ring-dipole end 202303 + else write( olog, * ) " # wrong choice of the equilibrium " @@ -1150,10 +1228,10 @@ SUBROUTINE geom_init_metric ggxz, ggyy, ggyz, ggzz, grootg_xyz, & gdomgdr, gdomgdt, gdomgdq, ggrr, ggrt, & ggrq, ggtt, ggtq, ggqq, grootg_rtq) - call mtr_global%xyz2rtq end do ! iz loop ends + call mtr_global%xyz2rtq call mtr_fourier%init call mtr_fourier%dft_rtq2coef(mtr_global) @@ -1161,8 +1239,7 @@ SUBROUTINE geom_init_metric if ( rankg == 0 ) then do iz = -global_nz, global_nz-1 - !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & - write( 900000001, fmt="(f15.8,SP,256E24.14e3)") & + write( omtr, fmt="(f15.8,SP,256E24.14e3)") & mtr_global%zz(iz), mtr_global%theta(iz), & mtr_global%omg(iz), mtr_global%domgdx(iz), & mtr_global%domgdy(iz), mtr_global%domgdz(iz), & @@ -1173,8 +1250,7 @@ SUBROUTINE geom_init_metric end do !call flush(omtr) do iz = -global_nz, global_nz-1 - !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & - write( 900000002, fmt="(f15.8,SP,256E24.14e3)") & + write( omtf, fmt="(f15.8,SP,256E24.14e3)") & mtr_global%zz(iz), mtr_global%theta(iz), & mtr_global%omg(iz), mtr_global%domgdr(iz), & mtr_global%domgdt(iz), mtr_global%domgdq(iz), & @@ -1186,535 +1262,523 @@ SUBROUTINE geom_init_metric !call flush(omtr) end if - - !%%% For debug %%% - do iz = -nz, nz-1 - write( 990000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & - mtr_local%zz(iz), mtr_local%theta(iz), & - mtr_local%omg(iz), mtr_local%domgdx(iz), & - mtr_local%domgdy(iz), mtr_local%domgdz(iz), & - mtr_local%gxx(iz), mtr_local%gxy(iz), & - mtr_local%gxz(iz), mtr_local%gyy(iz), & - mtr_local%gyz(iz), mtr_local%gzz(iz), & - mtr_local%rootg_xyz(iz) - write( 980000000+rankg, fmt="(f15.8,SP,256E24.14e3)") metric_l(:,iz) - end do - - call mtr_global%rtq2xyz - !call mtr_global%xyz2rtq - - call mtr_local%init(mtr_fourier, time_shearflow=0._DP) - - if ( rankg == 0 ) then - do iz = -global_nz, global_nz-1 - !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & - write( 900000011, fmt="(f15.8,SP,256E24.14e3)") & - mtr_global%zz(iz), mtr_global%theta(iz), & - mtr_global%omg(iz), mtr_global%domgdx(iz), & - mtr_global%domgdy(iz), mtr_global%domgdz(iz), & - mtr_global%gxx(iz), mtr_global%gxy(iz), & - mtr_global%gxz(iz), mtr_global%gyy(iz), & - mtr_global%gyz(iz), mtr_global%gzz(iz), & - mtr_global%rootg_xyz(iz) - end do - !call flush(omtr) - do iz = -global_nz, global_nz-1 - !write( omtr, fmt="(f15.8,SP,256E24.14e3)") & - write( 900000012, fmt="(f15.8,SP,256E24.14e3)") & - mtr_global%zz(iz), mtr_global%theta(iz), & - mtr_global%omg(iz), mtr_global%domgdr(iz), & - mtr_global%domgdt(iz), mtr_global%domgdq(iz), & - mtr_global%grr(iz), mtr_global%grt(iz), & - mtr_global%grq(iz), mtr_global%gtt(iz), & - mtr_global%gtq(iz), mtr_global%gqq(iz), & - mtr_global%rootg_rtq(iz) - end do - !call flush(omtr) - end if - - do iz = -nz, nz-1 - write( 970000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & - mtr_local%zz(iz), mtr_local%theta(iz), & - mtr_local%omg(iz), mtr_local%domgdx(iz), & - mtr_local%domgdy(iz), mtr_local%domgdz(iz), & - mtr_local%gxx(iz), mtr_local%gxy(iz), & - mtr_local%gxz(iz), mtr_local%gyy(iz), & - mtr_local%gyz(iz), mtr_local%gzz(iz), & - mtr_local%rootg_xyz(iz) - end do - - do iz = -nz, nz-1 - write( 900090000+rankg, fmt="(f15.8,SP,256E24.14e3)") & - mtr_local%zz_labframe(iz), mtr_local%theta(iz), & - mtr_local%omg(iz), mtr_local%domgdr(iz), & - mtr_local%domgdt(iz), mtr_local%domgdq(iz), & - mtr_local%grr(iz), mtr_local%grt(iz), & - mtr_local%grq(iz), mtr_local%gtt(iz), & - mtr_local%gtq(iz), mtr_local%gqq(iz), & - mtr_local%rootg_rtq(iz) - end do + ! do iz = -nz, nz-1 + ! write( 990000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & + ! mtr_local%zz(iz), mtr_local%theta(iz), & + ! mtr_local%omg(iz), mtr_local%domgdx(iz), & + ! mtr_local%domgdy(iz), mtr_local%domgdz(iz), & + ! mtr_local%gxx(iz), mtr_local%gxy(iz), & + ! mtr_local%gxz(iz), mtr_local%gyy(iz), & + ! mtr_local%gyz(iz), mtr_local%gzz(iz), & + ! mtr_local%rootg_xyz(iz) + ! end do + ! call mtr_global%rtq2xyz + ! call mtr_global%xyz2rtq + ! call mtr_local%init(mtr_fourier, time_shearflow=0._DP) + ! if ( rankg == 0 ) then + ! do iz = -global_nz, global_nz-1 + ! write( 900000011, fmt="(f15.8,SP,256E24.14e3)") & + ! mtr_global%zz(iz), mtr_global%theta(iz), & + ! mtr_global%omg(iz), mtr_global%domgdx(iz), & + ! mtr_global%domgdy(iz), mtr_global%domgdz(iz), & + ! mtr_global%gxx(iz), mtr_global%gxy(iz), & + ! mtr_global%gxz(iz), mtr_global%gyy(iz), & + ! mtr_global%gyz(iz), mtr_global%gzz(iz), & + ! mtr_global%rootg_xyz(iz) + ! end do + ! do iz = -global_nz, global_nz-1 + ! write( 900000012, fmt="(f15.8,SP,256E24.14e3)") & + ! mtr_global%zz(iz), mtr_global%theta(iz), & + ! mtr_global%omg(iz), mtr_global%domgdr(iz), & + ! mtr_global%domgdt(iz), mtr_global%domgdq(iz), & + ! mtr_global%grr(iz), mtr_global%grt(iz), & + ! mtr_global%grq(iz), mtr_global%gtt(iz), & + ! mtr_global%gtq(iz), mtr_global%gqq(iz), & + ! mtr_global%rootg_rtq(iz) + ! end do + ! end if + ! do iz = -nz, nz-1 + ! write( 980000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & + ! mtr_local%zz(iz), mtr_local%theta(iz), & + ! mtr_local%omg(iz), mtr_local%domgdx(iz), & + ! mtr_local%domgdy(iz), mtr_local%domgdz(iz), & + ! mtr_local%gxx(iz), mtr_local%gxy(iz), & + ! mtr_local%gxz(iz), mtr_local%gyy(iz), & + ! mtr_local%gyz(iz), mtr_local%gzz(iz), & + ! mtr_local%rootg_xyz(iz) + ! end do + ! do iz = -nz, nz-1 + ! write( 970000000+rankg, fmt="(f15.8,SP,256E24.14e3)") & + ! mtr_local%zz_labframe(iz), mtr_local%theta(iz), & + ! mtr_local%omg(iz), mtr_local%domgdr(iz), & + ! mtr_local%domgdt(iz), mtr_local%domgdq(iz), & + ! mtr_local%grr(iz), mtr_local%grt(iz), & + ! mtr_local%grq(iz), mtr_local%gtt(iz), & + ! mtr_local%gtq(iz), mtr_local%gqq(iz), & + ! mtr_local%rootg_rtq(iz) + ! end do !%%%%%%%%%%%%%%%%%% END SUBROUTINE geom_init_metric -!-------------------------------------- - SUBROUTINE geom_set_operators_old -!-------------------------------------- - implicit none - real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy - real(kind=DP) :: bb, kmo - real(kind=DP) :: gg0 - - real(kind=DP) :: cfsrf_l - real(kind=DP), dimension(1:3,1:3) :: gg - complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf - complex(kind=DP), dimension(:,:,:), allocatable :: nw - real(kind=DP), dimension(:,:,:), allocatable :: ww - - - integer :: mx, my, iz, iv, im, is - do iz = -nz, nz-1 - - omg(iz) = metric_l( 3,iz) - domgdx = metric_l( 4,iz) - domgdy = metric_l( 5,iz) - domgdz = metric_l( 6,iz) - gg(1,1) = metric_l( 7,iz) - gg(1,2) = metric_l( 8,iz) - gg(1,3) = metric_l( 9,iz) - gg(2,2) = metric_l(10,iz) - gg(2,3) = metric_l(11,iz) - gg(3,3) = metric_l(12,iz) - rootg(iz) = metric_l(13,iz) - -!!! for slab model - if ( trim(equib_type) == "slab") then - - dpara(iz) = dz * q_0 * r_major - - do im = 0, nm - vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) - mir(iz,im) = 0._DP - do iv = 1, 2*nv - vdx(iz,iv,im) = 0._DP - vdy(iz,iv,im) = 0._DP - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - end do - end do ! im loop ends - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 - end do - end do - -!!! for the concentric and large-aspect-ratio model !!! - else if( trim(equib_type) == "analytic" ) then - - dpara(iz) = dz * q_0 * r_major - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & - * ( sin(zz(iz)) & - + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) - - do iv = 1, 2*nv - vdx(iz,iv,im)= & - - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & - * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & - + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & - + ( 1._DP + s_hat * zz(iz) * 0._DP ) & - * ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im)= & - - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & - * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & - + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & - + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & - + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & - + ( 0._DP + s_hat * zz(iz) * 1._DP ) & - * ( sin( zz(iz) ) & - + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & - + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & - + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & - ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - - end do - - end do ! im loop ends - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = ( kx(mx) + s_hat * zz(iz) * ky(my) )**2 + ky(my)**2 - end do - end do - -!!! for s-alpha !!! <--- the current version is the same as "analytic" - else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then - - dpara(iz) = dz* q_0 * r_major - - kkx = -r_major * (q_0/q_bar) & - * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz - kky = r_major * (q_bar/q_0) & - * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - vdx(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) & - * (q_bar/q_0) - end do - - end do ! im loop ends - - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = ( kx(mx) + ( s_hat * zz(iz) - alpha_MHD*sin(zz(iz)) ) & - * ky(my) )**2 + ky(my)**2 ! with Shafranov shift - end do - end do - -!!! for circular MHD equilibrium !!! - else if( trim(equib_type) == "circ-MHD" ) then - - dpara(iz) = dz * omg(iz) * rootg(iz) - - kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) - kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - vdx(iz,iv,im)= & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im)= & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - end do - - end do ! im loop ends - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & - + 2._DP*kx(mx)*ky(my)*gg(1,2) & - + (ky(my)**2)*gg(2,2) - end do - end do - -! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) - else if( trim(equib_type) == "vmec" ) then - - dpara(iz) = dz * omg(iz) * rootg(iz) - - kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) - kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - vdx(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - - vdy(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & - - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term - * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - end do - - end do ! im loop ends - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & - + 2._DP*kx(mx)*ky(my)*gg(1,2) & - + (ky(my)**2)*gg(2,2) - end do - end do - - else if( trim(equib_type) == "eqdsk" ) then - - dpara(iz) = dz * omg(iz) * rootg(iz) - - kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) - kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) - - do im = 0, nm - - vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) - - mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) - - do iv = 1, 2*nv - vdx(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kkx & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vdy(iz,iv,im) = & - ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & - * kky & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & - - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term - * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & - * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) - - vsy(iz,iv,im) = & - - sgn(ranks) * tau(ranks) / Znum(ranks) & - * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & - + omg(iz)*mu(im) - 1.5_DP ) ) - end do - - end do ! im loop ends - - ksq(:,:,iz) = 0._DP - do my = ist_y, iend_y - do mx = -nx, nx - ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & - + 2._DP*kx(mx)*ky(my)*gg(1,2) & - + (ky(my)**2)*gg(2,2) - end do - end do - - else - - write( olog, * ) " # wrong choice of the equilibrium " - call flush(olog) - call MPI_Finalize(ierr_mpi) - stop - - end if - - - do im = 0, nm - do my = ist_y, iend_y - do mx = -nx, nx - kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & - * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) - call math_j0( kmo, j0(mx,my,iz,im) ) - call math_j1( kmo, j1(mx,my,iz,im) ) - call math_j2( kmo, j2(mx,my,iz,im) ) - end do - end do - end do - - - do my = ist_y, iend_y - do mx = -nx, nx - bb = ksq(mx,my,iz) / omg(iz)**2 & - * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) - call math_g0( bb, g0(mx,my,iz) ) - end do - end do - - end do ! iz loop ends - - cfsrf = 0._DP - cfsrf_l = 0._DP - do iz = -nz, nz-1 - cfsrf_l = cfsrf_l + rootg(iz) - ! normalization coefficient for - ! the surface average - end do - call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & - MPI_SUM, zsp_comm_world, ierr_mpi ) - - if ( vel_rank == 0 ) then - do iz = -nz, nz-1 - dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) - end do - end if - call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & - vel_comm_world, ierr_mpi ) - - do im = 0, nm - do iv = 1, 2*nv - do iz = -nz, nz-1 - fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & - / sqrt( twopi**3 ) - end do - end do - end do - - allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) - -! --- GK polarization factor for efield calculation - fct_poisson(:,:,:) = 0._DP - fct_e_energy(:,:,:) = 0._DP - - ww(:,:,:) = 0._DP - do iz = -nz, nz-1 - do my = ist_y, iend_y - do mx = -nx, nx - - if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode - - fct_poisson(mx,my,iz) = 0._DP - fct_e_energy(mx,my,iz) = 0._DP - - else - - ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) - do is = 0, ns-1 - bb = ksq(mx,my,iz) / omg(iz)**2 & - * tau(is)*Anum(is)/(Znum(is)**2) - call math_g0( bb, gg0 ) - ww(mx,my,iz) = ww(mx,my,iz) & - + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) - end do - fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) - fct_e_energy(mx,my,iz) = ww(mx,my,iz) - - end if - - end do - end do - end do - - -! --- ZF-factor for adiabatic model - if ( ns == 1 ) then - - ww(:,:,:) = 0._DP - do iz = -nz, nz-1 - my = 0 - do mx = -nx, nx - ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & - / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) - end do - end do - - call intgrl_fsrf ( ww, fctgt ) - - if ( rankw == 0 ) then - fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) - ! g0(0,0,iz) has no z dependence - endif - - endif - - deallocate( ww ) - - allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) - allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) - wf(:,:,:,:,:) = ( 0._DP, 0._DP ) - nw(:,:,:) = ( 0._DP, 0._DP ) - -! --- GK polarization factor for mfield calculation - fct_ampere(:,:,:) = 0._DP - fct_m_energy(:,:,:) = 0._DP - - if ( beta .ne. 0._DP ) then - - do im = 0, nm - do iv = 1, 2*nv - do iz = -nz, nz-1 - do my = ist_y, iend_y - do mx = -nx, nx - wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & - * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) - end do - end do - end do - end do - end do - - call intgrl_v0_moment_ms ( wf, nw ) - - do iz = -nz, nz-1 - do my = ist_y, iend_y - do mx = -nx, nx - fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) - fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta - end do - end do - end do - - if ( rankw == 0 ) then - do iz = -nz, nz-1 - fct_ampere(0,0,iz) = 0._DP - fct_m_energy(0,0,iz) = 0._DP - end do - end if - - end if - - deallocate( wf ) - deallocate( nw ) - - END SUBROUTINE geom_set_operators_old +!!-------------------------------------- +! SUBROUTINE geom_set_operators_old +!!-------------------------------------- +! implicit none +! real(kind=DP) :: kkx, kky, domgdz, domgdx, domgdy +! real(kind=DP) :: bb, kmo +! real(kind=DP) :: gg0 +! +! real(kind=DP) :: cfsrf_l +! real(kind=DP), dimension(1:3,1:3) :: gg +! complex(kind=DP), dimension(:,:,:,:,:), allocatable :: wf +! complex(kind=DP), dimension(:,:,:), allocatable :: nw +! real(kind=DP), dimension(:,:,:), allocatable :: ww +! +! +! integer :: mx, my, iz, iv, im, is +! do iz = -nz, nz-1 +! +! omg(iz) = metric_l( 3,iz) +! domgdx = metric_l( 4,iz) +! domgdy = metric_l( 5,iz) +! domgdz = metric_l( 6,iz) +! gg(1,1) = metric_l( 7,iz) +! gg(1,2) = metric_l( 8,iz) +! gg(1,3) = metric_l( 9,iz) +! gg(2,2) = metric_l(10,iz) +! gg(2,3) = metric_l(11,iz) +! gg(3,3) = metric_l(12,iz) +! rootg(iz) = metric_l(13,iz) +! +!!!! for slab model +! if ( trim(equib_type) == "slab") then +! +! dpara(iz) = dz * q_0 * r_major +! +! do im = 0, nm +! vp(iz,im) = sqrt( 2._DP * mu(im) )!* omg(iz) ) +! mir(iz,im) = 0._DP +! do iv = 1, 2*nv +! vdx(iz,iv,im) = 0._DP +! vdy(iz,iv,im) = 0._DP +! vsy(iz,iv,im) = & +! - sgn(ranks) * tau(ranks) / Znum(ranks) & +! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +! + omg(iz)*mu(im) - 1.5_DP ) ) +! end do +! end do ! im loop ends +! +! ksq(:,:,iz) = 0._DP +! do my = ist_y, iend_y +! do mx = -nx, nx +! ksq(mx,my,iz) = kx(mx)**2 + ky(my)**2 +! end do +! end do +! +!!!! for the concentric and large-aspect-ratio model !!! +! else if( trim(equib_type) == "analytic" ) then +! +! dpara(iz) = dz * q_0 * r_major +! +! do im = 0, nm +! +! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +! mir(iz,im) = mu(im) * eps_r / ( q_0 * r_major ) & +! * ( sin(zz(iz)) & +! + eps_hor * lmmq * sin( lmmq * zz(iz) - malpha ) & +! + eps_mor * lmmqm1 * sin( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * lmmqp1 * sin( lmmqp1 * zz(iz) - malpha ) ) +! +! do iv = 1, 2*nv +! vdx(iz,iv,im)= & +! - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & +! * ( 0._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & +! + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +! + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +! + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & +! + ( 1._DP + s_hat * zz(iz) * 0._DP ) & +! * ( sin( zz(iz) ) & +! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +! ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vdy(iz,iv,im)= & +! - ( vl(iv)**2 + omg(iz)*mu(im) ) * eps_rnew / r_major & +! * ( 1._DP * ( rdeps00 + rdeps1_0 * cos( zz(iz) ) & +! + rdeps2_10 * cos( lmmq * zz(iz) - malpha ) & +! + rdeps1_10 * cos( lmmqm1 * zz(iz) - malpha ) & +! + rdeps3_10 * cos( lmmqp1 * zz(iz) - malpha ) ) & +! + ( 0._DP + s_hat * zz(iz) * 1._DP ) & +! * ( sin( zz(iz) ) & +! + eps_hor * lprd * sin( lmmq * zz(iz) - malpha ) & +! + eps_mor * lprdm1 * sin( lmmqm1 * zz(iz) - malpha ) & +! + eps_por * lprdp1 * sin( lmmqp1 * zz(iz) - malpha ) ) & +! ) * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vsy(iz,iv,im) = & +! - sgn(ranks) * tau(ranks) / Znum(ranks) & +! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +! + omg(iz)*mu(im) - 1.5_DP ) ) +! +! end do +! +! end do ! im loop ends +! +! ksq(:,:,iz) = 0._DP +! do my = ist_y, iend_y +! do mx = -nx, nx +! ksq(mx,my,iz) = ( kx(mx) + s_hat * zz(iz) * ky(my) )**2 + ky(my)**2 +! end do +! end do +! +!!!! for s-alpha !!! <--- the current version is the same as "analytic" +! else if( trim(equib_type) == "s-alpha" .or. trim(equib_type) == "s-alpha-shift" ) then +! +! dpara(iz) = dz* q_0 * r_major +! +! kkx = -r_major * (q_0/q_bar) & +! * ( gg(1,1)*gg(2,3) - gg(1,2)*gg(1,3) )*domgdz +! kky = r_major * (q_bar/q_0) & +! * ( domgdx - ( gg(1,2)*gg(2,3) - gg(2,2)*gg(1,3) )*domgdz ) +! +! do im = 0, nm +! +! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +! +! mir(iz,im) = mu(im) * (q_0/q_bar) * domgdz / ( omg(iz)*rootg(iz) ) +! +! do iv = 1, 2*nv +! vdx(iz,iv,im) = & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & +! * kkx & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vdy(iz,iv,im) = & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / r_major & +! * kky & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vsy(iz,iv,im) = & +! - sgn(ranks) * tau(ranks) / Znum(ranks) & +! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +! + omg(iz)*mu(im) - 1.5_DP ) ) & +! * (q_bar/q_0) +! end do +! +! end do ! im loop ends +! +! +! ksq(:,:,iz) = 0._DP +! do my = ist_y, iend_y +! do mx = -nx, nx +! ksq(mx,my,iz) = ( kx(mx) + ( s_hat * zz(iz) - alpha_MHD*sin(zz(iz)) ) & +! * ky(my) )**2 + ky(my)**2 ! with Shafranov shift +! end do +! end do +! +!!!! for circular MHD equilibrium !!! +! else if( trim(equib_type) == "circ-MHD" ) then +! +! dpara(iz) = dz * omg(iz) * rootg(iz) +! +! kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) +! kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) +! +! do im = 0, nm +! +! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +! +! mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) +! +! do iv = 1, 2*nv +! vdx(iz,iv,im)= & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +! * kkx & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vdy(iz,iv,im)= & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +! * kky & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vsy(iz,iv,im) = & +! - sgn(ranks) * tau(ranks) / Znum(ranks) & +! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +! + omg(iz)*mu(im) - 1.5_DP ) ) +! end do +! +! end do ! im loop ends +! +! ksq(:,:,iz) = 0._DP +! do my = ist_y, iend_y +! do mx = -nx, nx +! ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & +! + 2._DP*kx(mx)*ky(my)*gg(1,2) & +! + (ky(my)**2)*gg(2,2) +! end do +! end do +! +!! this is new vmec-BoozXform interface by M. Nakata & M. Nunami (Aug. 2016) +! else if( trim(equib_type) == "vmec" ) then +! +! dpara(iz) = dz * omg(iz) * rootg(iz) +! +! kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) +! kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) +! +! do im = 0, nm +! +! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +! +! mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) +! +! do iv = 1, 2*nv +! vdx(iz,iv,im) = & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +! * kkx & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! +! vdy(iz,iv,im) = & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +! * kky & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & +! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term +! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vsy(iz,iv,im) = & +! - sgn(ranks) * tau(ranks) / Znum(ranks) & +! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +! + omg(iz)*mu(im) - 1.5_DP ) ) +! end do +! +! end do ! im loop ends +! +! ksq(:,:,iz) = 0._DP +! do my = ist_y, iend_y +! do mx = -nx, nx +! ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & +! + 2._DP*kx(mx)*ky(my)*gg(1,2) & +! + (ky(my)**2)*gg(2,2) +! end do +! end do +! +! else if( trim(equib_type) == "eqdsk" ) then +! +! dpara(iz) = dz * omg(iz) * rootg(iz) +! +! kkx = r_major*( -domgdy + (gg(1,3)*gg(1,2) - gg(1,1)*gg(2,3))*domgdz/omg(iz)**2 ) +! kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) +! +! do im = 0, nm +! +! vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) +! +! mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) +! +! do iv = 1, 2*nv +! vdx(iz,iv,im) = & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +! * kkx & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vdy(iz,iv,im) = & +! ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & +! * kky & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) & +! - real(ibprime,kind=DP) * vl(iv)**2 / r_major / omg(iz)**2 & ! grad-p (beta-prime) term +! * ( beta*(R0_Ln(ranks) + R0_Lt(ranks)) ) & +! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) +! +! vsy(iz,iv,im) = & +! - sgn(ranks) * tau(ranks) / Znum(ranks) & +! * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & +! + omg(iz)*mu(im) - 1.5_DP ) ) +! end do +! +! end do ! im loop ends +! +! ksq(:,:,iz) = 0._DP +! do my = ist_y, iend_y +! do mx = -nx, nx +! ksq(mx,my,iz) = (kx(mx)**2)*gg(1,1) & +! + 2._DP*kx(mx)*ky(my)*gg(1,2) & +! + (ky(my)**2)*gg(2,2) +! end do +! end do +! +! else +! +! write( olog, * ) " # wrong choice of the equilibrium " +! call flush(olog) +! call MPI_Finalize(ierr_mpi) +! stop +! +! end if +! +! +! do im = 0, nm +! do my = ist_y, iend_y +! do mx = -nx, nx +! kmo = sqrt( 2._DP * ksq(mx,my,iz) * mu(im) / omg(iz) ) & +! * dsqrt( tau(ranks)*Anum(ranks) ) / Znum(ranks) +! call math_j0( kmo, j0(mx,my,iz,im) ) +! call math_j1( kmo, j1(mx,my,iz,im) ) +! call math_j2( kmo, j2(mx,my,iz,im) ) +! end do +! end do +! end do +! +! +! do my = ist_y, iend_y +! do mx = -nx, nx +! bb = ksq(mx,my,iz) / omg(iz)**2 & +! * tau(ranks)*Anum(ranks)/(Znum(ranks)**2) +! call math_g0( bb, g0(mx,my,iz) ) +! end do +! end do +! +! end do ! iz loop ends +! +! cfsrf = 0._DP +! cfsrf_l = 0._DP +! do iz = -nz, nz-1 +! cfsrf_l = cfsrf_l + rootg(iz) +! ! normalization coefficient for +! ! the surface average +! end do +! call MPI_Allreduce( cfsrf_l, cfsrf, 1, MPI_DOUBLE_PRECISION, & +! MPI_SUM, zsp_comm_world, ierr_mpi ) +! +! if ( vel_rank == 0 ) then +! do iz = -nz, nz-1 +! dvp(iz) = sqrt( 2._DP * (0.5_DP * dm**2) * omg(iz) ) +! end do +! end if +! call MPI_Bcast( dvp, 2*nz, MPI_DOUBLE_PRECISION, 0, & +! vel_comm_world, ierr_mpi ) +! +! do im = 0, nm +! do iv = 1, 2*nv +! do iz = -nz, nz-1 +! fmx(iz,iv,im) = exp( - 0.5_DP * vl(iv)**2 - omg(iz) * mu(im) ) & +! / sqrt( twopi**3 ) +! end do +! end do +! end do +! +! allocate( ww(-nx:nx,0:ny,-nz:nz-1) ) +! +!! --- GK polarization factor for efield calculation +! fct_poisson(:,:,:) = 0._DP +! fct_e_energy(:,:,:) = 0._DP +! +! ww(:,:,:) = 0._DP +! do iz = -nz, nz-1 +! do my = ist_y, iend_y +! do mx = -nx, nx +! +! if ( rankw == 0 .and. mx == 0 .and. my == 0 ) then !- (0,0) mode +! +! fct_poisson(mx,my,iz) = 0._DP +! fct_e_energy(mx,my,iz) = 0._DP +! +! else +! +! ww(mx,my,iz) = lambda_i * ksq(mx,my,iz) +! do is = 0, ns-1 +! bb = ksq(mx,my,iz) / omg(iz)**2 & +! * tau(is)*Anum(is)/(Znum(is)**2) +! call math_g0( bb, gg0 ) +! ww(mx,my,iz) = ww(mx,my,iz) & +! + Znum(is) * fcs(is) / tau(is) * ( 1._DP - gg0 ) +! end do +! fct_poisson(mx,my,iz) = 1._DP / ww(mx,my,iz) +! fct_e_energy(mx,my,iz) = ww(mx,my,iz) +! +! end if +! +! end do +! end do +! end do +! +! +!! --- ZF-factor for adiabatic model +! if ( ns == 1 ) then +! +! ww(:,:,:) = 0._DP +! do iz = -nz, nz-1 +! my = 0 +! do mx = -nx, nx +! ww(mx,my,iz) = ( 1._DP - g0(mx,my,iz) ) & +! / ( 1._DP - g0(mx,my,iz) + tau(0)*tau_ad ) +! end do +! end do +! +! call intgrl_fsrf ( ww, fctgt ) +! +! if ( rankw == 0 ) then +! fctgt(0) = ( 1._DP - g0(0,0,0) ) / ( 1._DP - g0(0,0,0) + tau(0)*tau_ad ) +! ! g0(0,0,iz) has no z dependence +! endif +! +! endif +! +! deallocate( ww ) +! +! allocate( wf(-nx:nx,0:ny,-nz:nz-1,1:2*nv,0:nm) ) +! allocate( nw(-nx:nx,0:ny,-nz:nz-1) ) +! wf(:,:,:,:,:) = ( 0._DP, 0._DP ) +! nw(:,:,:) = ( 0._DP, 0._DP ) +! +!! --- GK polarization factor for mfield calculation +! fct_ampere(:,:,:) = 0._DP +! fct_m_energy(:,:,:) = 0._DP +! +! if ( beta .ne. 0._DP ) then +! +! do im = 0, nm +! do iv = 1, 2*nv +! do iz = -nz, nz-1 +! do my = ist_y, iend_y +! do mx = -nx, nx +! wf(mx,my,iz,iv,im) = Znum(ranks) * fcs(ranks) / Anum(ranks) & +! * vl(iv)**2 * j0(mx,my,iz,im)**2 * fmx(iz,iv,im) +! end do +! end do +! end do +! end do +! end do +! +! call intgrl_v0_moment_ms ( wf, nw ) +! +! do iz = -nz, nz-1 +! do my = ist_y, iend_y +! do mx = -nx, nx +! fct_ampere(mx,my,iz) = 1._DP / real( ksq(mx,my,iz) + beta * nw(mx,my,iz), kind=DP ) +! fct_m_energy(mx,my,iz) = ksq(mx,my,iz) / beta +! end do +! end do +! end do +! +! if ( rankw == 0 ) then +! do iz = -nz, nz-1 +! fct_ampere(0,0,iz) = 0._DP +! fct_m_energy(0,0,iz) = 0._DP +! end do +! end if +! +! end if +! +! deallocate( wf ) +! deallocate( nw ) +! +! END SUBROUTINE geom_set_operators_old !-------------------------------------- @@ -2013,6 +2077,50 @@ SUBROUTINE geom_set_operators end do end do +!sakano_ring-dipole st 202303 + else if( trim(equib_type) == "ring" ) then + + dpara(iz) = dz * omg(iz) * rootg(iz) + + kkx = 0._DP + kky = r_major*( domgdx + (gg(1,3)*gg(2,2) - gg(1,2)*gg(2,3))*domgdz/omg(iz)**2 ) + + do im = 0, nm +! r_major = 1 is assumed as the equilibrium length unit +! B on the equatorial plane is also unity + + vp(iz,im) = sqrt( 2._DP * mu(im) * omg(iz) ) + + !mir(iz,im) = mu(im) * ub_dot_grdb + mir(iz,im) = mu(im) * domgdz / ( omg(iz)*rootg(iz) ) + + do iv = 1, 2*nv + vdx(iz,iv,im) = 0._DP + + !vdy(iz,iv,im) = & + ! ( vl(iv)**2 + omg(iz)*mu(im) ) & + ! * ( ub_crs_grdb / omg(iz)**2 ) * sqrt( gg(2,2) ) & + ! * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) ! ion's vdy is negative y direction + vdy(iz,iv,im) = & + ( vl(iv)**2 + omg(iz)*mu(im) ) / ( r_major*omg(iz) ) & + * kky & + * ( sgn(ranks) * tau(ranks) / Znum(ranks) ) + vsy(iz,iv,im)= & + - sgn(ranks) * tau(ranks) / Znum(ranks) & + * ( R0_Ln(ranks) + R0_Lt(ranks) * ( 0.5_DP*vl(iv)**2 & + + omg(iz)*mu(im) - 1.5_DP ) ) ! ion's vsy is negative y directuin + end do + + end do ! im loop ends + + ksq(:,:,iz) = 0._DP + do my = ist_y, iend_y + do mx = -nx, nx + ksq(mx,my,iz) = ( kx(mx) * gg(1,1) )**2 + ( ky(my) * gg(2,2) )**2 + end do + end do +!sakano_ring-dipole end 202303 + else write( olog, * ) " # wrong choice of the equilibrium " @@ -2273,7 +2381,7 @@ SUBROUTINE metric_global_xyz2rtq(self) ! translate (x,y,z)->(r,t,q)=(rho,theta,zeta) ! NOTE: cx*rho0/(cy*q_0=1) is used. - gdomgdr = cx*gdomgdx + s_hat*wzz*gdomgdy + gdomgdr = cx*gdomgdx + cx*s_hat*wzz*gdomgdy gdomgdt = gdomgdz + cy*q_0*gdomgdy gdomgdq = - cy*gdomgdy ggrr = ggxx/cx**2 @@ -2572,19 +2680,20 @@ SUBROUTINE metric_local_copy_global(self, mtr_g) do iz = -nz, nz-1 giz = iz - global_nz + 2*nz * rankz + nz - self%zz(iz) = mtr_global%zz(giz) - self%theta(iz) = mtr_global%theta(giz) - self%omg(iz) = mtr_global%omg(giz) - self%domgdx(iz) = mtr_global%domgdx(giz) - self%domgdy(iz) = mtr_global%domgdy(giz) - self%domgdz(iz) = mtr_global%domgdz(giz) - self%gxx(iz) = mtr_global%gxx(giz) - self%gxy(iz) = mtr_global%gxy(giz) - self%gxz(iz) = mtr_global%gxz(giz) - self%gyy(iz) = mtr_global%gyy(giz) - self%gyz(iz) = mtr_global%gyz(giz) - self%gzz(iz) = mtr_global%gzz(giz) - self%rootg_xyz(iz) = mtr_global%rootg_xyz(giz) + self%zz_labframe(iz) = mtr_g%zz(giz) + self%zz(iz) = mtr_g%zz(giz) + self%theta(iz) = mtr_g%theta(giz) + self%omg(iz) = mtr_g%omg(giz) + self%domgdx(iz) = mtr_g%domgdx(giz) + self%domgdy(iz) = mtr_g%domgdy(giz) + self%domgdz(iz) = mtr_g%domgdz(giz) + self%gxx(iz) = mtr_g%gxx(giz) + self%gxy(iz) = mtr_g%gxy(giz) + self%gxz(iz) = mtr_g%gxz(giz) + self%gyy(iz) = mtr_g%gyy(giz) + self%gyz(iz) = mtr_g%gyz(giz) + self%gzz(iz) = mtr_g%gzz(giz) + self%rootg_xyz(iz) = mtr_g%rootg_xyz(giz) end do END SUBROUTINE metric_local_copy_global diff --git a/src/gkvp_header.f90 b/src/gkvp_header.f90 index f19f842..9f83910 100644 --- a/src/gkvp_header.f90 +++ b/src/gkvp_header.f90 @@ -233,6 +233,7 @@ MODULE GKV_header inbz = 14, & ivmc = 15, & omtr = 16, & + omtf = 17, & ovmc = olog diff --git a/src/gkvp_main.f90 b/src/gkvp_main.f90 index bfafc50..04c42e1 100644 --- a/src/gkvp_main.f90 +++ b/src/gkvp_main.f90 @@ -13,9 +13,9 @@ PROGRAM GKV_main ! | ! colli, colliimp, exb, shearflow ! | -! bndry, fft, fld, zfilter +! bndry, fft, fld, zfilter, geom ! | -! clock, intgrl, tips, freq, igs, vmecbzx, fileio +! clock, intgrl, tips, freq, igs, vmecbzx, ring, fileio ! | ! mpienv, math ! | diff --git a/src/gkvp_ring.f90 b/src/gkvp_ring.f90 new file mode 100644 index 0000000..7df18a1 --- /dev/null +++ b/src/gkvp_ring.f90 @@ -0,0 +1,474 @@ +MODULE ring_header + + implicit none + + integer, parameter :: DP = selected_real_kind(14) +! +! integer :: olog = 10 +! +! real(kind=DP) :: ring_a = 0.5_DP + + real(kind=DP) :: ring_a + + public ring_a + + +END MODULE ring_header + + +MODULE ring_func + + use ring_header + use GKV_math, only: math_eli1, math_eli2 + + implicit none + + private + + public func_k, func_g, func_psi, func_x, func_eli1, func_eli2 + + +CONTAINS + + + FUNCTION func_k( r, z ) + + real(kind=DP) :: func_k + real(kind=DP), intent(in) :: r, z + + func_k = sqrt( ( 4._DP * ring_a * abs(r) ) / ( ( ring_a + r )**2 + z**2 ) ) + + END FUNCTION func_k + + + FUNCTION func_g( r, z ) + + real(kind=DP) :: func_g + real(kind=DP), intent(in) :: r, z + + real(kind=DP) :: eli1, eli2, kk + + kk = func_k( r, z )**2 + + call math_eli1( kk, eli1 ) +!!! if( icon /= 0 ) print *, "# icon in celi1 = ", icon + call math_eli2( kk, eli2 ) +!!! if( icon /= 0 ) print *, "# icon in celi2 = ", icon + + func_g = ( ( 1._DP - 0.5_DP * kk ) * eli1 - eli2 ) & + * sqrt( ( ring_a + r )**2 + z**2 ) * 0.5_DP + + END FUNCTION func_g + + + FUNCTION func_psi( r, z ) + + real(kind=DP) :: func_psi + real(kind=DP), intent(in) :: r, z + + func_psi = func_g( r, z ) / func_g( 1._DP, 0._DP ) + + END FUNCTION func_psi + + + FUNCTION func_x( r, z, psi0 ) + + real(kind=DP) :: func_x + real(kind=DP), intent(in) :: r, z, psi0 + + func_x = (func_psi( 1._DP, 0._DP ) - func_psi( r, z ) ) / psi0 + + END FUNCTION func_x + + + FUNCTION func_eli1( r, z ) + + real(kind=DP) :: func_eli1 + real(kind=DP), intent(in) :: r, z + + real(kind=DP) :: eli1, kk + + kk = func_k( r, z )**2 + + call math_eli1( kk, eli1 ) + + func_eli1 = eli1 + + END FUNCTION func_eli1 + + + FUNCTION func_eli2( r, z ) + + real(kind=DP) :: func_eli2 + real(kind=DP), intent(in) :: r, z + + real(kind=DP) :: eli2, kk + + kk = func_k( r, z )**2 + + call math_eli2( kk, eli2 ) + + func_eli2 = eli2 + + END FUNCTION func_eli2 + + +END MODULE ring_func + + +MODULE ring_diff + + use ring_header + + implicit none + + private + + public diff_r, diff_z, diff_rho + + +CONTAINS + + + FUNCTION diff_r( fun, rin, zin ) + + real(kind=DP), external :: fun + real(kind=DP), intent(in) :: rin, zin + + real(kind=DP) :: diff_r + + real(kind=DP) :: dr1, dr2 + + + dr1 = abs( rin ) * 1.d-4 + dr2 = dr1 * 2._DP + + if( rin == 0._DP ) then + diff_r = 0._DP + + else + diff_r = ( - fun(rin+dr2,zin) + 8._DP*fun(rin+dr1,zin) & + - 8._DP*fun(rin-dr1,zin) + fun(rin-dr2,zin) ) & + / ( 12._DP * dr1 ) + + end if + + + END FUNCTION diff_r + + + FUNCTION diff_z( fun, rin, zin ) + + real(kind=DP), external :: fun + real(kind=DP), intent(in) :: rin, zin + + real(kind=DP) :: diff_z + + real(kind=DP) :: dz1, dz2 + + + dz1 = abs( zin ) * 1.d-4 + dz2 = dz1 * 2._DP + +! if( zin == 0._DP ) then + if( abs(zin) < 1.d-12) then + diff_z = 0._DP + + else + diff_z = ( - fun(rin,zin+dz2) + 8._DP*fun(rin,zin+dz1) & + - 8._DP*fun(rin,zin-dz1) + fun(rin,zin-dz2) ) & + / ( 12._DP * dz1 ) + + end if + + + END FUNCTION diff_z + + + FUNCTION diff_rho( fun, rin, zin ) + + real(kind=DP), external :: fun + real(kind=DP), intent(in) :: rin, zin + + real(kind=DP) :: diff_rho + +! real(kind=DP) :: rho, tht + real(kind=DP) :: tht + + +! rho = sqrt( ( rin - ring_a )**2 + zin**2 ) + tht = atan2( zin, rin - ring_a ) + + diff_rho = diff_r( fun, rin, zin ) * cos( tht ) & + + diff_z( fun, rin, zin ) * sin( tht ) + + + END FUNCTION diff_rho + + +END MODULE ring_diff + + +MODULE ring_bfld + + use ring_header + use ring_func + use ring_diff + + implicit none + + private + + public bfld_br, bfld_bz, bfld_magb, bfld_gradbr, bfld_gradbz + + +CONTAINS + + + FUNCTION bfld_br( r, z ) + + real(kind=DP) :: bfld_br + real(kind=DP), intent(in) :: r, z + +! bfld_br = diff_z( func_psi, r, z) / r + + bfld_br = diff_z( func_psi, r, z ) / r + + END FUNCTION bfld_br + + + FUNCTION bfld_bz( r, z ) + + real(kind=DP) :: bfld_bz + real(kind=DP), intent(in) :: r, z + +! bfld_bz = diff_r( func_psi, r, z ) / r + + bfld_bz = - diff_r( func_psi, r, z ) / r + + END FUNCTION bfld_bz + + + FUNCTION bfld_magb( r, z ) + + real(kind=DP) :: bfld_magb + real(kind=DP), intent(in) :: r, z + + real(kind=DP) :: br, bz + + br = bfld_br( r, z ) + bz = bfld_bz( r, z ) + + bfld_magb = sqrt( br**2 + bz**2 ) + +!!! print *, br, bz + + END FUNCTION bfld_magb + + + FUNCTION bfld_gradbr( r, z ) + + real(kind=DP) :: bfld_gradbr + real(kind=DP), intent(in) :: r, z + + bfld_gradbr = diff_r( bfld_magb, r, z ) + + END FUNCTION bfld_gradbr + + + FUNCTION bfld_gradbz( r, z ) + + real(kind=DP) :: bfld_gradbz + real(kind=DP), intent(in) :: r, z + + bfld_gradbz = diff_z( bfld_magb, r, z ) + + END FUNCTION bfld_gradbz + + +END MODULE ring_bfld + + +MODULE GKV_ring +!----------------------------------------------------------------- +! +! Flux tube coordinates in the ring dipole geometry +! +! Definition of the flux tube coordinates +! in the ring dipole geometry +! +! x = (Psi_0 - Psi) / (R_0*B'_0) +! y = R_0 * phi +! z = Theta (= arctan(Z/(R-a)) +! where (R, phi, Z ) are the cylindorical coordinates +! +! B'_0 = 1/R * (dPsi/dr - dPsi/dz) | r=1,z=0 +! B_0 = B / B'_0 | r=1,z=0 +! We also use the normalization of Psi_0*(gradx crs grady) = B_0*R_0^2 +! with R_0 = 1 and B_0 = 1 as the units +! +!----------------------------------------------------------------- + + use ring_header +! use gkv_header + use ring_func + use ring_diff + use ring_bfld + + implicit none + + private + + public ring_coordinates + + +CONTAINS + + SUBROUTINE ring_coordinates( a, tht, bb, ub_dot_grdb, ub_crs_grdb, & + gxx, gxy, gxz, gyy, gyz, gzz, rootg, dbdx, dbdz) + + real(kind=DP), intent(in) :: a, tht + real(kind=DP), intent(out) :: bb, ub_dot_grdb, ub_crs_grdb + real(kind=DP), intent(out) :: gxx, gxy, gxz, gyy, gyz, gzz, rootg +!>> + real(kind=DP), intent(out) :: dbdx, dbdz + real(kind=DP) :: R0, psi0 + real(kind=DP) :: eps_x, rho_p, rho_m, r_p, r_m, z_p, z_m +!<< + real(kind=DP) :: r, z, rho, rho1, hh, dh + + real(kind=DP) :: b0 + real(kind=DP) :: gbr, gbz, ubr, ubz!, psi_n, b_rootg_i, ub_dot_grdh + +! real(kind=DP) :: rootg2 + + real(kind=DP) :: eps, eps0 = 0.00000001_DP + integer :: ic, nc = 20 + + + ring_a = a + + rho = 1._DP - ring_a + + hh = 0._DP + dh = acos(-1._DP) * 0.01_DP + + + +! compute for hh +!!! do while ( hh < abs(tht)-dh*0.5 ) + do while ( hh < abs(tht)-dh ) + hh = hh + dh + + eps = 1._DP + ic = 0 + + r = rho * cos(hh) + ring_a + z = rho * sin(hh) + + do while ( eps > eps0 .AND. ic < nc ) + + ic = ic + 1 + + rho1 = rho - ( func_psi( r, z ) - 1._DP ) / diff_rho( func_psi, r, z ) + eps = abs( rho1 - rho ) / abs( rho ) + rho = rho1 + + r = rho * cos(hh) + ring_a + z = rho * sin(hh) + if( abs(z) < 1.d-14 ) z = 0._DP + + end do +!!! print *, "# ic, tht, rho1, psi = ", ic, tht, rho, func_psi( r, z ) + + end do + +! compute for tht + eps = 1._DP + ic = 0 + + r = rho * cos(tht) + ring_a + z = rho * sin(tht) + + do while ( eps > eps0 .AND. ic < nc ) + + ic = ic + 1 + + rho1 = rho - ( func_psi( r, z ) - 1._DP ) / diff_rho( func_psi, r, z ) + eps = abs( rho1 - rho ) / abs( rho ) + rho = rho1 + + r = rho * cos(tht) + ring_a + z = rho * sin(tht) + if( abs(z) < 1.d-14 ) z = 0._DP + + end do + + if( ic == nc ) then + print *, "# ic, tht, rho1, psi = ", ic, tht, rho, func_psi( r, z ) + end if + +!>> + R0 = 1._DP + eps_x = 0.0000001_DP + rho_p = rho + eps_x + r_p = rho_p * cos(tht) + ring_a + z_p = rho_p * sin(tht) + rho_m = rho - eps_x + r_m = rho_m * cos(tht) + ring_a + z_m = rho_m * sin(tht) +!<< + + b0 = bfld_magb( 1._DP, 0._DP ) + + bb = bfld_magb ( r, z )/b0 + +!>> + psi0 = b0*R0**2 + dbdx = ( bfld_magb( r_p, z_p ) - bfld_magb( r_m, z_m ) )/b0/( func_x(r_p, z_p, psi0) - func_x(r_m, z_m, psi0) ) +!<< + + ubr = bfld_br( r, z )/b0 / bb + ubz = bfld_bz( r, z )/b0 / bb + + gbr = bfld_gradbr( r, z )/b0 + gbz = bfld_gradbz( r, z )/b0 + + ub_dot_grdb = ubr * gbr + ubz * gbz + ub_crs_grdb = ubz * gbr - ubr * gbz + +! ub_dot_grdh = - ubr * sin( tht ) + ubz * cos( tht ) + +! psi_n = func_psi( r, z ) / func_psi( 1._DP, 0._DP ) + + gxx = ( r * bb )**2 + gxy = 0._DP + gxz = - r * bb * ( ubz*sin(tht) + ubr*cos(tht) ) / rho + gyy = 1._DP / r**2 + gyz = 0._DP + gzz = 1._DP / rho**2 + rootg = 1._DP / sqrt( gyy*( gxx*gzz - gxz**2 ) ) + +!>> + dbdz = ub_dot_grdb * bb * rootg +!<< + +! b_rootg_i = 1._DP / ( bb * rootg ) + +! rootg2= r * rho * b0 / ( diff_r( func_psi, r, z )*cos(tht) & +! + diff_z( func_psi, r, z )*sin(tht) ) +! rootg2= 1._DP / ( ubz * bb * cos(tht) & +! - ubr * bb * sin(tht) ) + +!! debug +! write(unit=6, fmt="(1p, 32e15.7)" ) tht, rho, r, z, func_psi(r,z), & +! bb, ubr, ubz, gbr, gbz, ub_dot_grdb, ub_crs_grdb, ub_dot_grdh, & +! psi_n, gxx, gxy, gxz, gyy, gyz, gzz, rootg, b_rootg_i, rootg2 +!! debug + + + + END SUBROUTINE ring_coordinates + + +END MODULE GKV_ring diff --git a/src/gkvp_set.f90 b/src/gkvp_set.f90 index 6b3a2df..b5a5a03 100644 --- a/src/gkvp_set.f90 +++ b/src/gkvp_set.f90 @@ -67,7 +67,8 @@ SUBROUTINE set_init( ff, phi, Al, hh, time ) trim(equib_type) == "s-alpha-shift" .OR. & trim(equib_type) == "circ-MHD" .OR. & trim(equib_type) == "vmec" .OR. & - trim(equib_type) == "eqdsk" ) then + trim(equib_type) == "eqdsk" .OR. & + trim(equib_type) == "ring" ) then call set_cnfig @@ -180,6 +181,7 @@ SUBROUTINE set_start if( rankg == 0 ) then open( omtr, file=trim(f_hst)//"mtr."//cnew ) + open( omtf, file=trim(f_hst)//"mtf."//cnew ) open( odtc, file=trim(f_hst)//"dtc."//cnew ) open( oeng, file=trim(f_hst)//"eng."//cnew ) open( omen, file=trim(f_hst)//"men."//cnew ) @@ -266,6 +268,7 @@ SUBROUTINE set_close if( rankg == 0 ) then close( omtr ) + close( omtf ) close( odtc ) close( oeng ) close( omen ) diff --git a/src/gkvp_vmecbzx.f90 b/src/gkvp_vmecbzx.f90 index f2c9f98..25bbb64 100644 --- a/src/gkvp_vmecbzx.f90 +++ b/src/gkvp_vmecbzx.f90 @@ -6,6 +6,9 @@ MODULE GKV_vmecbzx ! ! Update history of gkvp_vmecbxz.f90 ! -------------- +! gkvp_f0.62 (S. Maeyama, Mar 2023) +! - Input of vmecbzx_boozxcoef is modified from local iz for each rankz +! to global index giz. ! gkvp_f0.57 (S. Maeyama, Oct 2020) ! - Version number f0.57 is removed from filename. ! @@ -43,9 +46,9 @@ SUBROUTINE vmecbzx_boozx_read( nss, ntheta, nzeta ) implicit none integer, intent(in) :: nss, ntheta, nzeta - integer :: is, jj, ierr, ibzx + integer :: ibzx character(512) :: f_bozx - character(512) :: env_string !fj +! character(512) :: env_string !fj namelist /bozxf/ f_bozx @@ -132,14 +135,20 @@ END SUBROUTINE vmecbzx_boozx_read !---------------------------------------------------------------------------------- - SUBROUTINE vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz, lz_l, & ! input +!smae start 202303 +! SUBROUTINE vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz, lz_l, & ! input + SUBROUTINE vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, giz, zz, lz_l, & ! input +!smae end 202303 s_0, q_0, s_hat, eps_r, phi_ax, & ! output omg, rootg, domgdx, domgdz, domgdy, & gg11, gg12, gg13, gg22, & gg23, gg33 ) !---------------------------------------------------------------------------------- - integer, intent(in) :: isw, nss, ntheta, nzeta, iz +!smae start 202303 +! integer, intent(in) :: isw, nss, ntheta, nzeta, iz + integer, intent(in) :: isw, nss, ntheta, nzeta, giz +!smae end 202303 real(kind=DP), intent(in) :: s_input, zz, lz_l real(kind=DP), intent(inout) :: s_0, q_0, s_hat, eps_r, phi_ax @@ -147,8 +156,8 @@ SUBROUTINE vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz, real(kind=DP), intent(out) :: gg11, gg12, gg13, gg22, gg23, gg33 ! --- local variables - integer :: is, jj, is0, iz0, nz0, jj0, zt0, giz - real(kind=DP) :: zz0, eps_a + integer :: is0, jj0, zt0 + real(kind=DP) :: eps_a ! is0 = nint(s_input*(nss+1)) @@ -164,7 +173,9 @@ SUBROUTINE vmecbzx_boozx_coeff( isw, nss, ntheta, nzeta, s_input, iz, zz, else if ( isw == 1 ) then s_0 = ss_bz(is0) - giz = (-global_nz + 2*nz*rankz + iz + nz ) +!smae start 202303 +! giz = (-global_nz + 2*nz*rankz + iz + nz ) +!smae end 202303 jj0 = giz + ntheta/2 From af75da82758f42fc70c1a673bbbfb1fafa62b420 Mon Sep 17 00:00:00 2001 From: smaeyama Date: Tue, 14 Mar 2023 16:06:41 +0900 Subject: [PATCH 3/6] Update history is remarked. --- README_for_namelist.txt | 27 +- Version_memo.txt | 10 +- lib/gkvp_math_portable.f90 | 2 + run/gkvp_namelist | 16 +- src/gkvp_advnc.f90 | 3 + src/gkvp_geom.f90 | 792 +------------------------------------ src/gkvp_header.f90 | 5 + src/gkvp_set.f90 | 3 + 8 files changed, 58 insertions(+), 800 deletions(-) diff --git a/README_for_namelist.txt b/README_for_namelist.txt index 470449b..9d93e2a 100644 --- a/README_for_namelist.txt +++ b/README_for_namelist.txt @@ -1,12 +1,13 @@ -NOTE for gkvp_f0.30 S. Maeyama March 2013 -Updated for gkvp_f0.40 M. Nakata June 2014 -Updated for gkvp_f0.45 M. Nakata July 2015 -Updated for gkvp_f0.46 S. Maeyama May 2016 -Updated for gkvp_f0.47 S. Maeyama Nov 2016 -Updated for gkvp_f0.48 S. Maeyama Dec 2016 -Updated for gkvp_f0.50 S. Maeyama Sep 2017 -Updated for gkvp_f0.55 M. Nakata Dec 2019 +Updated for gkvp_f0.62 S. Maeyama March 2023 Updated for gkvp_f0.61 S. Maeyama March 2021 +Updated for gkvp_f0.55 M. Nakata Dec 2019 +Updated for gkvp_f0.50 S. Maeyama Sep 2017 +Updated for gkvp_f0.48 S. Maeyama Dec 2016 +Updated for gkvp_f0.47 S. Maeyama Nov 2016 +Updated for gkvp_f0.46 S. Maeyama May 2016 +Updated for gkvp_f0.45 M. Nakata July 2015 +Updated for gkvp_f0.40 M. Nakata June 2014 +NOTE for gkvp_f0.30 S. Maeyama March 2013 %%% How to run the code %%% @@ -66,6 +67,7 @@ equib_type: "analytic" - Analytic helical field with the metrics in cylinder "vmec" - Tokamak/stellarator field from the VMEC code "eqdsk" - Tokamak field (MEUDAS/TOPICS or G-EQDSK) via IGS code "slab" - Shearless slab geometry + "ring" - Ring dipole geometry inum: current shot number @@ -156,6 +158,15 @@ del_c: mode connection phase in fluxtube model eps_r ~~ malpha : geometrical parameters such as safety factor, B-shear, etc. +&ring: parameters for ring dipole geometry + ! There is a ring current at R=a. The field line passing through (R,Z)=(R0,0) is picked up as a flux-tube domain. + ! The reference length is set to be R0 (not the ring current at R=a). + ! The reference magnetic field strength is B0 at (R,Z)=(R0,0). + +ring_a: = a / R0, which specify a flux tube of the ring dipole. + +kxmin: Minimum wavenumber in kx, valid only when equib_type == "ring" + &vmecp -- &bozxf : parameters for vmec equilibrium &igsp -- &igsf : parameters for tokamak (g-eqdsk) equilibrium diff --git a/Version_memo.txt b/Version_memo.txt index f6bde1b..6d11a21 100644 --- a/Version_memo.txt +++ b/Version_memo.txt @@ -1,3 +1,12 @@ +gkvp_f0.62 S. Maeyama Mar 2023 +1) equib_type = "ring" is added for ring dipole geometry. + +2) Rotating flux-tube model is implemented to treat equilibrium shearflows, + available for torus: equib_type = "s-alpha", "s-alpha-shift", "analytic", + "circMHD", "vmec", "igs". (But not available for "slab", "ring") + + + gkvp_f0.61 S. Maeyama Mar 2021 1) equib_type = "s-alpha-shift" is added. s-alpha model with Shafranov shift. @@ -7,7 +16,6 @@ gkvp_f0.61 S. Maeyama Mar 2021 - gkvp_f0.60 S. Maeyama Feb 2021 1) NetCDF4+parallel HDF5 is added for optional output of GKV. diff --git a/lib/gkvp_math_portable.f90 b/lib/gkvp_math_portable.f90 index 26e1b28..a151358 100644 --- a/lib/gkvp_math_portable.f90 +++ b/lib/gkvp_math_portable.f90 @@ -5,6 +5,8 @@ MODULE GKV_math ! ! Update history of gkvp_set.f90 ! -------------- +! gkvp_f0.62 (S. Maeyama, Mar 2023) +! - Elliptic integrals math_eli1, math_eli2 are added. ! gkvp_f0.61 (S. Maeyama, Mar 2021) ! - random_seed is added for reproducibility. ! diff --git a/run/gkvp_namelist b/run/gkvp_namelist index c056c03..d75e94a 100644 --- a/run/gkvp_namelist +++ b/run/gkvp_namelist @@ -1,5 +1,5 @@ &cmemo memo="GKV-plus f0.61 developed for pre-exa-scale computing", &end - &calct calc_type="linear", + &calct calc_type="lin_freq", z_bound="outflow", z_filt="off", z_calc="cf4", @@ -7,7 +7,7 @@ init_random=.false., num_triad_diag=0, &end &triad mxt = 0, myt = 0/ - &equib equib_type = "s-alpha", &end + &equib equib_type = "analytic", &end &run_n inum=%%%, ch_res = .false., &end &files f_log="%%DIR%%/log/gkvp.", @@ -25,8 +25,8 @@ adapt_dt = .true., courant_num = 0.5d0, time_advnc = "auto_init", &end - &physp R0_Ln = 2.2d0, - R0_Lt = 10.d0, + &physp R0_Ln = 2.22d0, + R0_Lt = 6.92d0, nu = 1.d0, Anum = 1.d0, Znum = 1.d0, @@ -39,17 +39,17 @@ beta = 0.d0, ibprime = 0, vmax = 4.5d0, - nx0 = 0, &end + nx0 = 10000, &end &rotat mach = 0.d0, uprime = 0.d0, gamma_e = 0.d0, &end - &nperi n_tht = 1, - kymin = 0.5d0, + &nperi n_tht = 3, + kymin = 0.05d0, m_j = 1, del_c = 0.d0, &end &confp eps_r = 0.18d0, eps_rnew = 1.d0, - q_0 = 1.39d0, + q_0 = 1.4d0, s_hat = 0.8d0, lprd = 0.d0, mprd = 0.d0, diff --git a/src/gkvp_advnc.f90 b/src/gkvp_advnc.f90 index 44b0355..3cd53a5 100644 --- a/src/gkvp_advnc.f90 +++ b/src/gkvp_advnc.f90 @@ -5,6 +5,9 @@ MODULE GKV_advnc ! ! Update history of gkvp_advnc.f90 ! -------------- +! gkvp_f0.62 (S. Maeyama, Mar 2023) +! - Time-dependent metrics for rotating flux-tube model is implemented. +! See lines at "!%%% For shearflow rotating flux tube model %%%". ! gkvp_f0.57 (S. Maeyama, Oct 2020) ! - Version number f0.57 is removed from filename. ! - Unitialized access for padding iend_y Date: Wed, 15 Mar 2023 15:50:45 +0900 Subject: [PATCH 4/6] Makefile for Fugaku --- run/Makefile | 226 +++++++++++++++++---------------- run/backup/Makefile_fugaku | 167 ++++++++++++------------ run/backup/Makefile_fugaku_old | 139 ++++++++++++++++++++ 3 files changed, 346 insertions(+), 186 deletions(-) create mode 100644 run/backup/Makefile_fugaku_old diff --git a/run/Makefile b/run/Makefile index d078f99..e22bb03 100644 --- a/run/Makefile +++ b/run/Makefile @@ -1,130 +1,142 @@ -###FC = mpinfort -FC = mpinfort -compiler /opt/nec/ve/nfort/3.0.4/bin/nfort -FFLAGS = -report-all -O3 -fpp $(EXTRA) #-mparallel -FFLAGS += -fdiag-vector=2 -fdiag-inline=2 -fdiag-parallel=2 -FFLAGS_OMP1= #-fopenmp #around FFT -FFLAGS_OMP2= #-fopenmp #others -FFLAGS_OMP3= #-fopenmp #bndry&advnc +### Fujitsu Fortran Compiler ### +FC = mpifrtpx +FFLAGS = -Kfast,parallel # Optimization +FFLAGS += -X9 # Fortran95 +FFLAGS += -Koptmsg=2 -Nlst=t # Optimization report +FFLAGS += -fw # Suppress message +FFLAGS += -Kopenmp #-Nfjomplib # OpenMP +FFLAGS += -mcmodel=large # Static memory larger than 2GB +#FFLAGS += -Haefosux -NRtrap #-O0 # Debug +OPTRPT = 'lst' +#FFLAGS += -Nfjprof # Fujitsu profiler fapp +#FFLAGS += -Ksimd_nouse_multiple_structures # Specific option for compiler tcs1.2.26 to avoid slowing down GKV +#FFLAGS += -Knosch_pre_ra # Specific option for compiler tcs1.2.26 to avoid slowing down GKV -ifneq ("x$(FFLAGS_OMP1)_$(FFLAGS_OMP2)_$(FFLAGS_OMP3)_","x___") - FFLAGS_LOMP= -fopenmp -endif PROG = 'gkvp.exe' -SDIR = src -SRC = ../$(SDIR)/ +SRC = ../src/ MYL = ../lib/ MATH = gkvp_math_portable -FFT = gkvp_f0.56_fft_fftw_tune2r_0813 +FFT = gkvp_fft_fftw ### Usage of FFTW -ifeq ($(FFT),gkvp_f0.56_fft_fftw_tune2r_0813) - NLC_HOME=/opt/nec/ve/nlc/2.1.0 - INC = -I$(NLC_HOME)/include - LIB = -L$(NLC_HOME)/lib -laslfftw3 -lasl_sequential -ftrace - #LIB = -L$(NLC_HOME)/lib -laslfftw3 -lasl_openmp +ifeq ($(FFT),gkvp_fft_fftw) + ### FFTW-SVE + FFTW_DIR=/home/apps/r/OSS_CN/fftw-3.3.8/ + INC = -I$(FFTW_DIR)/include + LIB = -L$(FFTW_DIR)/lib64 -lfftw3 -lm -SSL2 + #### FFTW-SPACK (. /home/apps/oss/spack/share/spack/setup-env.sh; spack load fftw) ### + #FFTW_DIR=`spack location -i fftw` + #INC = -I$(FFTW_DIR)/include + #LIB = -L$(FFTW_DIR)/lib -lfftw3 -lm -SSL2 endif FILEIO=gkvp_fileio_fortran #FILEIO=gkvp_fileio_netcdf -### Usage of NetCDF (module load netcdf-parallelIO-fortran-sx) +### Usage of NetCDF (. /home/apps/oss/spack/share/spack/setup-env.sh; spack load netcdf-fortran%fj) ### +### Operation of NetCDF has not yet been checked on Fugaku, Jan 26 2021 ifeq ($(FILEIO),gkvp_fileio_netcdf) - FC = mpinfort - #INC += -I$(NFORT_INCLUDE_PATH) - #LIB += -L$(NFORT_LIBRARY_PATH) -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 - LIB += -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 + NETCDF_DIR=`spack location -i netcdf-fortran%fj` + INC += -I$(NETCDF_DIR)/include + LIB += -L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 endif +OBJS = gkvp_header.o\ + gkvp_mpienv.o\ + $(MATH).o\ + gkvp_clock.o\ + $(FILEIO).o\ + gkvp_intgrl.o\ + gkvp_tips.o\ + gkvp_vmecbzx.o\ + gkvp_igs.o\ + gkvp_ring.o\ + gkvp_bndry.o\ + gkvp_colli.o\ + $(FFT).o\ + gkvp_fld.o\ + gkvp_colliimp.o\ + gkvp_freq.o\ + gkvp_zfilter.o\ + gkvp_geom.o\ + gkvp_exb.o\ + gkvp_trans.o\ + gkvp_advnc.o\ + gkvp_shearflow.o\ + gkvp_dtc.o\ + gkvp_out.o\ + gkvp_set.o\ + gkvp_main.o -gkvp: $(SRC)gkvp_header.f90\ - $(SRC)gkvp_mpienv.f90\ - $(MYL)$(MATH).f90\ - $(SRC)gkvp_clock.f90\ - $(SRC)$(FILEIO).f90\ - $(SRC)gkvp_intgrl.f90\ - $(SRC)gkvp_tips.f90\ - $(SRC)gkvp_vmecbzx.f90\ - $(SRC)gkvp_igs.f90\ - $(SRC)gkvp_f0.56_bndry_tune_nec1.f90\ - $(SRC)gkvp_f0.56_colli_tune_nifs.f90\ - $(SRC)$(FFT).f90\ - $(SRC)gkvp_fld.f90\ - $(SRC)gkvp_colliimp.f90\ - $(SRC)gkvp_freq.f90\ - $(SRC)gkvp_f0.56_zfilter_tune_nec1.f90\ - $(SRC)gkvp_f0.56_exb_tune2r_0813.f90\ - $(SRC)gkvp_trans.f90\ - $(SRC)gkvp_shearflow.f90\ - $(SRC)gkvp_geom.f90\ - $(SRC)gkvp_advnc.f90\ - $(SRC)gkvp_dtc.f90\ - $(SRC)gkvp_out.f90\ - $(SRC)gkvp_set.f90\ - $(SRC)gkvp_main.f90 - - $(FC) $(FFLAGS) -c $(SRC)gkvp_header.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_mpienv.f90 - $(FC) $(FFLAGS) -c $(MYL)$(MATH).f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_clock.f90 - $(FC) $(FFLAGS) -c $(SRC)$(FILEIO).f90 $(INC) - $(FC) $(FFLAGS) -c $(SRC)gkvp_intgrl.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP3) -c $(SRC)gkvp_f0.56_bndry_tune_nec1.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP2) -c $(SRC)gkvp_f0.56_colli_tune_nifs.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP1) -c $(SRC)$(FFT).f90 $(INC) - $(FC) $(FFLAGS) -c $(SRC)gkvp_fld.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP2) -c $(SRC)gkvp_f0.56_zfilter_tune_nec1.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP1) -c $(SRC)gkvp_f0.56_exb_tune2r_0813.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP1) -c $(SRC)gkvp_trans.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_shearflow.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP3) -c $(SRC)gkvp_advnc.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_dtc.f90 - $(FC) $(FFLAGS) $(FFLAGS_OMP2) -c $(SRC)gkvp_out.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_set.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_main.f90 - - $(FC) $(FFLAGS) $(FFLAGS_LOMP) \ - gkvp_header.o\ - gkvp_mpienv.o\ - $(MATH).o\ - gkvp_clock.o\ - $(FILEIO).o\ - gkvp_intgrl.o\ - gkvp_tips.o\ - gkvp_vmecbzx.o\ - gkvp_igs.o\ - gkvp_f0.56_bndry_tune_nec1.o\ - gkvp_f0.56_colli_tune_nifs.o\ - $(FFT).o\ - gkvp_fld.o\ - gkvp_colliimp.o\ - gkvp_freq.o\ - gkvp_f0.56_zfilter_tune_nec1.o\ - gkvp_f0.56_exb_tune2r_0813.o\ - gkvp_trans.o\ - gkvp_shearflow.o\ - gkvp_geom.o\ - gkvp_advnc.o\ - gkvp_dtc.o\ - gkvp_out.o\ - gkvp_set.o\ - gkvp_main.o\ - -o $(PROG) $(LIB) +main: + (cp Makefile $(SRC); cd $(SRC); make gkvp) +gkvp: $(OBJS) + $(FC) $(FFLAGS) $(OBJS) -o $(PROG) $(LIB) + mv $(PROG) ../run/ - \cp *.L *.o *.mod ../$(SDIR)/ - \rm -f *.L *.o *.mod +#------------------------------> +gkvp_advnc.o : gkvp_advnc.f90 gkvp_geom.o gkvp_tips.o gkvp_zfilter.o gkvp_clock.o gkvp_bndry.o gkvp_colliimp.o gkvp_colli.o gkvp_exb.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_bndry.o : gkvp_bndry.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_clock.o : gkvp_clock.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_colli.o : gkvp_colli.f90 gkvp_bndry.o gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_colliimp.o : gkvp_colliimp.f90 gkvp_fld.o $(MATH).o gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_dtc.o : gkvp_dtc.f90 gkvp_colliimp.o gkvp_exb.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_exb.o : gkvp_exb.f90 gkvp_clock.o $(FFT).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +$(FFT).o : $(FFT).f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< $(INC) +$(FILEIO).o : $(FILEIO).f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< $(INC) +gkvp_fld.o : gkvp_fld.f90 gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_freq.o : gkvp_freq.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_geom.o : gkvp_geom.f90 gkvp_ring.o gkvp_igs.o gkvp_vmecbzx.o gkvp_intgrl.o $(MATH).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_header.o : gkvp_header.f90 + $(FC) $(FFLAGS) -c $< +gkvp_igs.o : gkvp_igs.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_intgrl.o : gkvp_intgrl.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_main.o : gkvp_main.f90 gkvp_shearflow.o gkvp_tips.o gkvp_freq.o $(FFT).o gkvp_colliimp.o gkvp_advnc.o gkvp_fld.o gkvp_dtc.o gkvp_out.o gkvp_clock.o gkvp_set.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_mpienv.o : gkvp_mpienv.f90 gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_out.o : gkvp_out.f90 $(FILEIO).o gkvp_tips.o gkvp_dtc.o gkvp_colliimp.o gkvp_advnc.o gkvp_freq.o gkvp_trans.o gkvp_fld.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_ring.o : gkvp_ring.f90 $(MATH).o + $(FC) $(FFLAGS) -c $< +gkvp_set.o : gkvp_set.f90 gkvp_geom.o $(FILEIO).o gkvp_tips.o gkvp_colliimp.o gkvp_colli.o gkvp_dtc.o gkvp_advnc.o gkvp_bndry.o gkvp_fld.o $(MATH).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_shearflow.o : gkvp_shearflow.f90 gkvp_tips.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_tips.o : gkvp_tips.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_trans.o : gkvp_trans.f90 $(FILEIO).o gkvp_exb.o gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_vmecbzx.o : gkvp_vmecbzx.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_vmecin.o : gkvp_vmecin.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_zfilter.o : gkvp_zfilter.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +$(MATH).o : $(MYL)$(MATH).f90 $(MYL)Bessel0_Zeros.f90 gkvp_header.o + $(FC) $(FFLAGS) -c $< +#------------------------------< clean: - rm -f ../$(SDIR)/*.LL ../$(SDIR)/*.L ../$(SDIR)/*.o ../$(SDIR)/*.mod ../$(SDIR)/*.lst - rm -f ./*.exe ./sub.q.* ./gkvp_namelist.* + rm -f ../src/Makefile ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ + ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* clear: - rm -f ./*.o ./*.mod ./*.L ./*.LL + rm -f ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* diff --git a/run/backup/Makefile_fugaku b/run/backup/Makefile_fugaku index 8ae2a55..e22bb03 100644 --- a/run/backup/Makefile_fugaku +++ b/run/backup/Makefile_fugaku @@ -43,89 +43,98 @@ ifeq ($(FILEIO),gkvp_fileio_netcdf) LIB += -L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 endif +OBJS = gkvp_header.o\ + gkvp_mpienv.o\ + $(MATH).o\ + gkvp_clock.o\ + $(FILEIO).o\ + gkvp_intgrl.o\ + gkvp_tips.o\ + gkvp_vmecbzx.o\ + gkvp_igs.o\ + gkvp_ring.o\ + gkvp_bndry.o\ + gkvp_colli.o\ + $(FFT).o\ + gkvp_fld.o\ + gkvp_colliimp.o\ + gkvp_freq.o\ + gkvp_zfilter.o\ + gkvp_geom.o\ + gkvp_exb.o\ + gkvp_trans.o\ + gkvp_advnc.o\ + gkvp_shearflow.o\ + gkvp_dtc.o\ + gkvp_out.o\ + gkvp_set.o\ + gkvp_main.o -gkvp: $(SRC)gkvp_header.f90\ - $(SRC)gkvp_mpienv.f90\ - $(MYL)$(MATH).f90\ - $(SRC)gkvp_clock.f90\ - $(SRC)$(FILEIO).f90\ - $(SRC)gkvp_intgrl.f90\ - $(SRC)gkvp_tips.f90\ - $(SRC)gkvp_vmecbzx.f90\ - $(SRC)gkvp_igs.f90\ - $(SRC)gkvp_bndry.f90\ - $(SRC)gkvp_colli.f90\ - $(SRC)$(FFT).f90\ - $(SRC)gkvp_fld.f90\ - $(SRC)gkvp_colliimp.f90\ - $(SRC)gkvp_freq.f90\ - $(SRC)gkvp_zfilter.f90\ - $(SRC)gkvp_exb.f90\ - $(SRC)gkvp_trans.f90\ - $(SRC)gkvp_advnc.f90\ - $(SRC)gkvp_shearflow.f90\ - $(SRC)gkvp_dtc.f90\ - $(SRC)gkvp_out.f90\ - $(SRC)gkvp_set.f90\ - $(SRC)gkvp_main.f90 +main: + (cp Makefile $(SRC); cd $(SRC); make gkvp) +gkvp: $(OBJS) + $(FC) $(FFLAGS) $(OBJS) -o $(PROG) $(LIB) + mv $(PROG) ../run/ - $(FC) $(FFLAGS) -c $(SRC)gkvp_header.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_mpienv.f90 - $(FC) $(FFLAGS) -c $(MYL)$(MATH).f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_clock.f90 - $(FC) $(FFLAGS) -c $(SRC)$(FILEIO).f90 $(INC) - $(FC) $(FFLAGS) -c $(SRC)gkvp_intgrl.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 - $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) - $(FC) $(FFLAGS) -c $(SRC)gkvp_fld.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_shearflow.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_dtc.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_out.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_set.f90 - $(FC) $(FFLAGS) -c $(SRC)gkvp_main.f90 - - $(FC) $(FFLAGS) \ - gkvp_header.o\ - gkvp_mpienv.o\ - $(MATH).o\ - gkvp_clock.o\ - $(FILEIO).o\ - gkvp_intgrl.o\ - gkvp_tips.o\ - gkvp_vmecbzx.o\ - gkvp_igs.o\ - gkvp_bndry.o\ - gkvp_colli.o\ - $(FFT).o\ - gkvp_fld.o\ - gkvp_colliimp.o\ - gkvp_freq.o\ - gkvp_zfilter.o\ - gkvp_exb.o\ - gkvp_trans.o\ - gkvp_advnc.o\ - gkvp_shearflow.o\ - gkvp_dtc.o\ - gkvp_out.o\ - gkvp_set.o\ - gkvp_main.o\ - -o $(PROG) $(LIB) - - cp *.o *.mod *.$(OPTRPT) ../src/ - rm -f *.o *.mod *.$(OPTRPT) +#------------------------------> +gkvp_advnc.o : gkvp_advnc.f90 gkvp_geom.o gkvp_tips.o gkvp_zfilter.o gkvp_clock.o gkvp_bndry.o gkvp_colliimp.o gkvp_colli.o gkvp_exb.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_bndry.o : gkvp_bndry.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_clock.o : gkvp_clock.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_colli.o : gkvp_colli.f90 gkvp_bndry.o gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_colliimp.o : gkvp_colliimp.f90 gkvp_fld.o $(MATH).o gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_dtc.o : gkvp_dtc.f90 gkvp_colliimp.o gkvp_exb.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_exb.o : gkvp_exb.f90 gkvp_clock.o $(FFT).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +$(FFT).o : $(FFT).f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< $(INC) +$(FILEIO).o : $(FILEIO).f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< $(INC) +gkvp_fld.o : gkvp_fld.f90 gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_freq.o : gkvp_freq.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_geom.o : gkvp_geom.f90 gkvp_ring.o gkvp_igs.o gkvp_vmecbzx.o gkvp_intgrl.o $(MATH).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_header.o : gkvp_header.f90 + $(FC) $(FFLAGS) -c $< +gkvp_igs.o : gkvp_igs.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_intgrl.o : gkvp_intgrl.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_main.o : gkvp_main.f90 gkvp_shearflow.o gkvp_tips.o gkvp_freq.o $(FFT).o gkvp_colliimp.o gkvp_advnc.o gkvp_fld.o gkvp_dtc.o gkvp_out.o gkvp_clock.o gkvp_set.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_mpienv.o : gkvp_mpienv.f90 gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_out.o : gkvp_out.f90 $(FILEIO).o gkvp_tips.o gkvp_dtc.o gkvp_colliimp.o gkvp_advnc.o gkvp_freq.o gkvp_trans.o gkvp_fld.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_ring.o : gkvp_ring.f90 $(MATH).o + $(FC) $(FFLAGS) -c $< +gkvp_set.o : gkvp_set.f90 gkvp_geom.o $(FILEIO).o gkvp_tips.o gkvp_colliimp.o gkvp_colli.o gkvp_dtc.o gkvp_advnc.o gkvp_bndry.o gkvp_fld.o $(MATH).o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_shearflow.o : gkvp_shearflow.f90 gkvp_tips.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_tips.o : gkvp_tips.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_trans.o : gkvp_trans.f90 $(FILEIO).o gkvp_exb.o gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_vmecbzx.o : gkvp_vmecbzx.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_vmecin.o : gkvp_vmecin.f90 gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +gkvp_zfilter.o : gkvp_zfilter.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o + $(FC) $(FFLAGS) -c $< +$(MATH).o : $(MYL)$(MATH).f90 $(MYL)Bessel0_Zeros.f90 gkvp_header.o + $(FC) $(FFLAGS) -c $< +#------------------------------< clean: - rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ + rm -f ../src/Makefile ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* clear: diff --git a/run/backup/Makefile_fugaku_old b/run/backup/Makefile_fugaku_old new file mode 100644 index 0000000..ec85633 --- /dev/null +++ b/run/backup/Makefile_fugaku_old @@ -0,0 +1,139 @@ +### Fujitsu Fortran Compiler ### +FC = mpifrtpx +FFLAGS = -Kfast,parallel # Optimization +FFLAGS += -X9 # Fortran95 +FFLAGS += -Koptmsg=2 -Nlst=t # Optimization report +FFLAGS += -fw # Suppress message +FFLAGS += -Kopenmp #-Nfjomplib # OpenMP +FFLAGS += -mcmodel=large # Static memory larger than 2GB +#FFLAGS += -Haefosux -NRtrap #-O0 # Debug +OPTRPT = 'lst' +#FFLAGS += -Nfjprof # Fujitsu profiler fapp +#FFLAGS += -Ksimd_nouse_multiple_structures # Specific option for compiler tcs1.2.26 to avoid slowing down GKV +#FFLAGS += -Knosch_pre_ra # Specific option for compiler tcs1.2.26 to avoid slowing down GKV + + +PROG = 'gkvp.exe' + +SRC = ../src/ +MYL = ../lib/ + +MATH = gkvp_math_portable + +FFT = gkvp_fft_fftw +### Usage of FFTW +ifeq ($(FFT),gkvp_fft_fftw) + ### FFTW-SVE + FFTW_DIR=/home/apps/r/OSS_CN/fftw-3.3.8/ + INC = -I$(FFTW_DIR)/include + LIB = -L$(FFTW_DIR)/lib64 -lfftw3 -lm -SSL2 + #### FFTW-SPACK (. /home/apps/oss/spack/share/spack/setup-env.sh; spack load fftw) ### + #FFTW_DIR=`spack location -i fftw` + #INC = -I$(FFTW_DIR)/include + #LIB = -L$(FFTW_DIR)/lib -lfftw3 -lm -SSL2 +endif + +FILEIO=gkvp_fileio_fortran +#FILEIO=gkvp_fileio_netcdf +### Usage of NetCDF (. /home/apps/oss/spack/share/spack/setup-env.sh; spack load netcdf-fortran%fj) ### +### Operation of NetCDF has not yet been checked on Fugaku, Jan 26 2021 +ifeq ($(FILEIO),gkvp_fileio_netcdf) + NETCDF_DIR=`spack location -i netcdf-fortran%fj` + INC += -I$(NETCDF_DIR)/include + LIB += -L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 +endif + + +gkvp: $(SRC)gkvp_header.f90\ + $(SRC)gkvp_mpienv.f90\ + $(MYL)$(MATH).f90\ + $(SRC)gkvp_clock.f90\ + $(SRC)$(FILEIO).f90\ + $(SRC)gkvp_intgrl.f90\ + $(SRC)gkvp_tips.f90\ + $(SRC)gkvp_vmecbzx.f90\ + $(SRC)gkvp_igs.f90\ + $(SRC)gkvp_ring.f90\ + $(SRC)gkvp_bndry.f90\ + $(SRC)gkvp_colli.f90\ + $(SRC)$(FFT).f90\ + $(SRC)gkvp_fld.f90\ + $(SRC)gkvp_colliimp.f90\ + $(SRC)gkvp_freq.f90\ + $(SRC)gkvp_zfilter.f90\ + $(SRC)gkvp_geom.f90\ + $(SRC)gkvp_exb.f90\ + $(SRC)gkvp_trans.f90\ + $(SRC)gkvp_advnc.f90\ + $(SRC)gkvp_shearflow.f90\ + $(SRC)gkvp_dtc.f90\ + $(SRC)gkvp_out.f90\ + $(SRC)gkvp_set.f90\ + $(SRC)gkvp_main.f90 + + $(FC) $(FFLAGS) -c $(SRC)gkvp_header.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_mpienv.f90 + $(FC) $(FFLAGS) -c $(MYL)$(MATH).f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_clock.f90 + $(FC) $(FFLAGS) -c $(SRC)$(FILEIO).f90 $(INC) + $(FC) $(FFLAGS) -c $(SRC)gkvp_intgrl.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_ring.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 + $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) + $(FC) $(FFLAGS) -c $(SRC)gkvp_fld.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_shearflow.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_dtc.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_out.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_set.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_main.f90 + + $(FC) $(FFLAGS) \ + gkvp_header.o\ + gkvp_mpienv.o\ + $(MATH).o\ + gkvp_clock.o\ + $(FILEIO).o\ + gkvp_intgrl.o\ + gkvp_tips.o\ + gkvp_vmecbzx.o\ + gkvp_igs.o\ + gkvp_ring.o\ + gkvp_bndry.o\ + gkvp_colli.o\ + $(FFT).o\ + gkvp_fld.o\ + gkvp_colliimp.o\ + gkvp_freq.o\ + gkvp_zfilter.o\ + gkvp_geom.o\ + gkvp_exb.o\ + gkvp_trans.o\ + gkvp_advnc.o\ + gkvp_shearflow.o\ + gkvp_dtc.o\ + gkvp_out.o\ + gkvp_set.o\ + gkvp_main.o\ + -o $(PROG) $(LIB) + + cp *.o *.mod *.$(OPTRPT) ../src/ + rm -f *.o *.mod *.$(OPTRPT) + +clean: + rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ + ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* + +clear: + rm -f ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* + From 97be366561b1f1fc8759524800a5eef1072c0e5a Mon Sep 17 00:00:00 2001 From: smaeyama Date: Wed, 15 Mar 2023 15:57:23 +0900 Subject: [PATCH 5/6] Makefile for ubuntu --- run/Makefile | 1 + run/backup/Makefile_fugaku | 1 + run/backup/Makefile_ubuntu | 60 ++++++++++++++++++++------------------ 3 files changed, 33 insertions(+), 29 deletions(-) diff --git a/run/Makefile b/run/Makefile index e22bb03..31a60ec 100644 --- a/run/Makefile +++ b/run/Makefile @@ -72,6 +72,7 @@ OBJS = gkvp_header.o\ main: (cp Makefile $(SRC); cd $(SRC); make gkvp) + gkvp: $(OBJS) $(FC) $(FFLAGS) $(OBJS) -o $(PROG) $(LIB) mv $(PROG) ../run/ diff --git a/run/backup/Makefile_fugaku b/run/backup/Makefile_fugaku index e22bb03..31a60ec 100644 --- a/run/backup/Makefile_fugaku +++ b/run/backup/Makefile_fugaku @@ -72,6 +72,7 @@ OBJS = gkvp_header.o\ main: (cp Makefile $(SRC); cd $(SRC); make gkvp) + gkvp: $(OBJS) $(FC) $(FFLAGS) $(OBJS) -o $(PROG) $(LIB) mv $(PROG) ../run/ diff --git a/run/backup/Makefile_ubuntu b/run/backup/Makefile_ubuntu index 69a6d29..d39bc97 100644 --- a/run/backup/Makefile_ubuntu +++ b/run/backup/Makefile_ubuntu @@ -58,70 +58,72 @@ OBJS = gkvp_header.o\ gkvp_set.o\ gkvp_main.o +main: + (cp Makefile $(SRC); cd $(SRC); make gkvp) + gkvp: $(OBJS) $(FC) $(FFLAGS) $(OBJS) -o $(PROG) $(LIB) - cp *.o *.mod ../src/ - rm -f *.o *.mod + mv $(PROG) ../run/ #------------------------------> -gkvp_advnc.o : $(SRC)gkvp_advnc.f90 gkvp_geom.o gkvp_tips.o gkvp_zfilter.o gkvp_clock.o gkvp_bndry.o gkvp_colliimp.o gkvp_colli.o gkvp_exb.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o +gkvp_advnc.o : gkvp_advnc.f90 gkvp_geom.o gkvp_tips.o gkvp_zfilter.o gkvp_clock.o gkvp_bndry.o gkvp_colliimp.o gkvp_colli.o gkvp_exb.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_bndry.o : $(SRC)gkvp_bndry.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o +gkvp_bndry.o : gkvp_bndry.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_clock.o : $(SRC)gkvp_clock.f90 gkvp_mpienv.o gkvp_header.o +gkvp_clock.o : gkvp_clock.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_colli.o : $(SRC)gkvp_colli.f90 gkvp_bndry.o gkvp_clock.o gkvp_mpienv.o gkvp_header.o +gkvp_colli.o : gkvp_colli.f90 gkvp_bndry.o gkvp_clock.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_colliimp.o : $(SRC)gkvp_colliimp.f90 gkvp_fld.o $(MATH).o gkvp_clock.o gkvp_mpienv.o gkvp_header.o +gkvp_colliimp.o : gkvp_colliimp.f90 gkvp_fld.o $(MATH).o gkvp_clock.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_dtc.o : $(SRC)gkvp_dtc.f90 gkvp_colliimp.o gkvp_exb.o gkvp_mpienv.o gkvp_header.o +gkvp_dtc.o : gkvp_dtc.f90 gkvp_colliimp.o gkvp_exb.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_exb.o : $(SRC)gkvp_exb.f90 gkvp_clock.o $(FFT).o gkvp_mpienv.o gkvp_header.o +gkvp_exb.o : gkvp_exb.f90 gkvp_clock.o $(FFT).o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -$(FFT).o : $(SRC)$(FFT).f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o +$(FFT).o : $(FFT).f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< $(INC) -$(FILEIO).o : $(SRC)$(FILEIO).f90 gkvp_mpienv.o gkvp_header.o +$(FILEIO).o : $(FILEIO).f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< $(INC) -gkvp_fld.o : $(SRC)gkvp_fld.f90 gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o +gkvp_fld.o : gkvp_fld.f90 gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_freq.o : $(SRC)gkvp_freq.f90 gkvp_mpienv.o gkvp_header.o +gkvp_freq.o : gkvp_freq.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_geom.o : $(SRC)gkvp_geom.f90 gkvp_ring.o gkvp_igs.o gkvp_vmecbzx.o gkvp_intgrl.o $(MATH).o gkvp_mpienv.o gkvp_header.o +gkvp_geom.o : gkvp_geom.f90 gkvp_ring.o gkvp_igs.o gkvp_vmecbzx.o gkvp_intgrl.o $(MATH).o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_header.o : $(SRC)gkvp_header.f90 +gkvp_header.o : gkvp_header.f90 $(FC) $(FFLAGS) -c $< -gkvp_igs.o : $(SRC)gkvp_igs.f90 gkvp_mpienv.o gkvp_header.o +gkvp_igs.o : gkvp_igs.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_intgrl.o : $(SRC)gkvp_intgrl.f90 gkvp_mpienv.o gkvp_header.o +gkvp_intgrl.o : gkvp_intgrl.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_main.o : $(SRC)gkvp_main.f90 gkvp_shearflow.o gkvp_tips.o gkvp_freq.o $(FFT).o gkvp_colliimp.o gkvp_advnc.o gkvp_fld.o gkvp_dtc.o gkvp_out.o gkvp_clock.o gkvp_set.o gkvp_mpienv.o gkvp_header.o +gkvp_main.o : gkvp_main.f90 gkvp_shearflow.o gkvp_tips.o gkvp_freq.o $(FFT).o gkvp_colliimp.o gkvp_advnc.o gkvp_fld.o gkvp_dtc.o gkvp_out.o gkvp_clock.o gkvp_set.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_mpienv.o : $(SRC)gkvp_mpienv.f90 gkvp_header.o +gkvp_mpienv.o : gkvp_mpienv.f90 gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_out.o : $(SRC)gkvp_out.f90 $(FILEIO).o gkvp_tips.o gkvp_dtc.o gkvp_colliimp.o gkvp_advnc.o gkvp_freq.o gkvp_trans.o gkvp_fld.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o +gkvp_out.o : gkvp_out.f90 $(FILEIO).o gkvp_tips.o gkvp_dtc.o gkvp_colliimp.o gkvp_advnc.o gkvp_freq.o gkvp_trans.o gkvp_fld.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_ring.o : $(SRC)gkvp_ring.f90 $(MATH).o +gkvp_ring.o : gkvp_ring.f90 $(MATH).o $(FC) $(FFLAGS) -c $< -gkvp_set.o : $(SRC)gkvp_set.f90 gkvp_geom.o $(FILEIO).o gkvp_tips.o gkvp_colliimp.o gkvp_colli.o gkvp_dtc.o gkvp_advnc.o gkvp_bndry.o gkvp_fld.o $(MATH).o gkvp_mpienv.o gkvp_header.o +gkvp_set.o : gkvp_set.f90 gkvp_geom.o $(FILEIO).o gkvp_tips.o gkvp_colliimp.o gkvp_colli.o gkvp_dtc.o gkvp_advnc.o gkvp_bndry.o gkvp_fld.o $(MATH).o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_shearflow.o : $(SRC)gkvp_shearflow.f90 gkvp_tips.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o +gkvp_shearflow.o : gkvp_shearflow.f90 gkvp_tips.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_tips.o : $(SRC)gkvp_tips.f90 gkvp_mpienv.o gkvp_header.o +gkvp_tips.o : gkvp_tips.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_trans.o : $(SRC)gkvp_trans.f90 $(FILEIO).o gkvp_exb.o gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o +gkvp_trans.o : gkvp_trans.f90 $(FILEIO).o gkvp_exb.o gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_vmecbzx.o : $(SRC)gkvp_vmecbzx.f90 gkvp_mpienv.o gkvp_header.o +gkvp_vmecbzx.o : gkvp_vmecbzx.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_vmecin.o : $(SRC)gkvp_vmecin.f90 gkvp_mpienv.o gkvp_header.o +gkvp_vmecin.o : gkvp_vmecin.f90 gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< -gkvp_zfilter.o : $(SRC)gkvp_zfilter.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o +gkvp_zfilter.o : gkvp_zfilter.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o $(FC) $(FFLAGS) -c $< $(MATH).o : $(MYL)$(MATH).f90 $(MYL)Bessel0_Zeros.f90 gkvp_header.o $(FC) $(FFLAGS) -c $< #------------------------------< clean: - rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ + rm -f ../src/Makefile ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* clear: From d029c7183bce17a66616accce7885132c6d8251d Mon Sep 17 00:00:00 2001 From: smaeyama Date: Wed, 15 Mar 2023 17:54:21 +0900 Subject: [PATCH 6/6] Makefile for jfrs, flow --- run/Makefile | 201 +++++++++++++++++++-------------------- run/backup/Makefile_flow | 6 ++ run/backup/Makefile_jfrs | 6 ++ run/shoot | 14 +-- run/sub.q | 171 +++++++++++++++++++-------------- 5 files changed, 212 insertions(+), 186 deletions(-) diff --git a/run/Makefile b/run/Makefile index 31a60ec..71a0a2c 100644 --- a/run/Makefile +++ b/run/Makefile @@ -9,8 +9,10 @@ FFLAGS += -mcmodel=large # Static memory larger than 2GB #FFLAGS += -Haefosux -NRtrap #-O0 # Debug OPTRPT = 'lst' #FFLAGS += -Nfjprof # Fujitsu profiler fapp -#FFLAGS += -Ksimd_nouse_multiple_structures # Specific option for compiler tcs1.2.26 to avoid slowing down GKV -#FFLAGS += -Knosch_pre_ra # Specific option for compiler tcs1.2.26 to avoid slowing down GKV +FFLAGS += -Ksimd_nouse_multiple_structures # Specific option for compiler tcs1.2.26 to avoid slowing down GKV +FFLAGS += -Knosch_pre_ra # Specific option for compiler tcs1.2.26 to avoid slowing down GKV +INC = +LIB = PROG = 'gkvp.exe' @@ -21,121 +23,112 @@ MYL = ../lib/ MATH = gkvp_math_portable FFT = gkvp_fft_fftw -### Usage of FFTW +### Usage of FFTW (module load fftw-tune) ifeq ($(FFT),gkvp_fft_fftw) - ### FFTW-SVE - FFTW_DIR=/home/apps/r/OSS_CN/fftw-3.3.8/ - INC = -I$(FFTW_DIR)/include - LIB = -L$(FFTW_DIR)/lib64 -lfftw3 -lm -SSL2 - #### FFTW-SPACK (. /home/apps/oss/spack/share/spack/setup-env.sh; spack load fftw) ### - #FFTW_DIR=`spack location -i fftw` - #INC = -I$(FFTW_DIR)/include - #LIB = -L$(FFTW_DIR)/lib -lfftw3 -lm -SSL2 + #INC += -I$(FFTW_DIR)/include + #LIB += -L$(FFTW_DIR)/lib -lfftw3 -lm + LIB += -lfftw3 -lm endif FILEIO=gkvp_fileio_fortran #FILEIO=gkvp_fileio_netcdf -### Usage of NetCDF (. /home/apps/oss/spack/share/spack/setup-env.sh; spack load netcdf-fortran%fj) ### -### Operation of NetCDF has not yet been checked on Fugaku, Jan 26 2021 +### Usage of NetCDF (module load netcdf-fortran netcdf-c phdf5) +### NetCDF does not work on the FLOW supercomputer for now, Jan 17 2021 ifeq ($(FILEIO),gkvp_fileio_netcdf) - NETCDF_DIR=`spack location -i netcdf-fortran%fj` - INC += -I$(NETCDF_DIR)/include - LIB += -L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 + #INC += -I$(NETCDF_FORTRAN_DIR)/include -I$(NETCDF_DIR)/include -I$(PHDF5_DIR)/include + #LIB += -L$(NETCDF_FORTRAN_DIR)/lib -L$(NETCDF_DIR)/lib -L$(PHDF5_DIR)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 + LIB += -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 endif -OBJS = gkvp_header.o\ - gkvp_mpienv.o\ - $(MATH).o\ - gkvp_clock.o\ - $(FILEIO).o\ - gkvp_intgrl.o\ - gkvp_tips.o\ - gkvp_vmecbzx.o\ - gkvp_igs.o\ - gkvp_ring.o\ - gkvp_bndry.o\ - gkvp_colli.o\ - $(FFT).o\ - gkvp_fld.o\ - gkvp_colliimp.o\ - gkvp_freq.o\ - gkvp_zfilter.o\ - gkvp_geom.o\ - gkvp_exb.o\ - gkvp_trans.o\ - gkvp_advnc.o\ - gkvp_shearflow.o\ - gkvp_dtc.o\ - gkvp_out.o\ - gkvp_set.o\ - gkvp_main.o -main: - (cp Makefile $(SRC); cd $(SRC); make gkvp) +gkvp: $(SRC)gkvp_header.f90\ + $(SRC)gkvp_mpienv.f90\ + $(MYL)$(MATH).f90\ + $(SRC)gkvp_clock.f90\ + $(SRC)$(FILEIO).f90\ + $(SRC)gkvp_intgrl.f90\ + $(SRC)gkvp_tips.f90\ + $(SRC)gkvp_vmecbzx.f90\ + $(SRC)gkvp_igs.f90\ + $(SRC)gkvp_ring.f90\ + $(SRC)gkvp_bndry.f90\ + $(SRC)gkvp_colli.f90\ + $(SRC)$(FFT).f90\ + $(SRC)gkvp_fld.f90\ + $(SRC)gkvp_colliimp.f90\ + $(SRC)gkvp_freq.f90\ + $(SRC)gkvp_zfilter.f90\ + $(SRC)gkvp_geom.f90\ + $(SRC)gkvp_exb.f90\ + $(SRC)gkvp_trans.f90\ + $(SRC)gkvp_advnc.f90\ + $(SRC)gkvp_shearflow.f90\ + $(SRC)gkvp_dtc.f90\ + $(SRC)gkvp_out.f90\ + $(SRC)gkvp_set.f90\ + $(SRC)gkvp_main.f90 -gkvp: $(OBJS) - $(FC) $(FFLAGS) $(OBJS) -o $(PROG) $(LIB) - mv $(PROG) ../run/ + $(FC) $(FFLAGS) -c $(SRC)gkvp_header.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_mpienv.f90 + $(FC) $(FFLAGS) -c $(MYL)$(MATH).f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_clock.f90 + $(FC) $(FFLAGS) -c $(SRC)$(FILEIO).f90 $(INC) + $(FC) $(FFLAGS) -c $(SRC)gkvp_intgrl.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_ring.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 + $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) + $(FC) $(FFLAGS) -c $(SRC)gkvp_fld.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_shearflow.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_dtc.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_out.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_set.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_main.f90 -#------------------------------> -gkvp_advnc.o : gkvp_advnc.f90 gkvp_geom.o gkvp_tips.o gkvp_zfilter.o gkvp_clock.o gkvp_bndry.o gkvp_colliimp.o gkvp_colli.o gkvp_exb.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_bndry.o : gkvp_bndry.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_clock.o : gkvp_clock.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_colli.o : gkvp_colli.f90 gkvp_bndry.o gkvp_clock.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_colliimp.o : gkvp_colliimp.f90 gkvp_fld.o $(MATH).o gkvp_clock.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_dtc.o : gkvp_dtc.f90 gkvp_colliimp.o gkvp_exb.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_exb.o : gkvp_exb.f90 gkvp_clock.o $(FFT).o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -$(FFT).o : $(FFT).f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< $(INC) -$(FILEIO).o : $(FILEIO).f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< $(INC) -gkvp_fld.o : gkvp_fld.f90 gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_freq.o : gkvp_freq.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_geom.o : gkvp_geom.f90 gkvp_ring.o gkvp_igs.o gkvp_vmecbzx.o gkvp_intgrl.o $(MATH).o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_header.o : gkvp_header.f90 - $(FC) $(FFLAGS) -c $< -gkvp_igs.o : gkvp_igs.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_intgrl.o : gkvp_intgrl.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_main.o : gkvp_main.f90 gkvp_shearflow.o gkvp_tips.o gkvp_freq.o $(FFT).o gkvp_colliimp.o gkvp_advnc.o gkvp_fld.o gkvp_dtc.o gkvp_out.o gkvp_clock.o gkvp_set.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_mpienv.o : gkvp_mpienv.f90 gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_out.o : gkvp_out.f90 $(FILEIO).o gkvp_tips.o gkvp_dtc.o gkvp_colliimp.o gkvp_advnc.o gkvp_freq.o gkvp_trans.o gkvp_fld.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_ring.o : gkvp_ring.f90 $(MATH).o - $(FC) $(FFLAGS) -c $< -gkvp_set.o : gkvp_set.f90 gkvp_geom.o $(FILEIO).o gkvp_tips.o gkvp_colliimp.o gkvp_colli.o gkvp_dtc.o gkvp_advnc.o gkvp_bndry.o gkvp_fld.o $(MATH).o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_shearflow.o : gkvp_shearflow.f90 gkvp_tips.o gkvp_fld.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_tips.o : gkvp_tips.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_trans.o : gkvp_trans.f90 $(FILEIO).o gkvp_exb.o gkvp_clock.o gkvp_intgrl.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_vmecbzx.o : gkvp_vmecbzx.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_vmecin.o : gkvp_vmecin.f90 gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -gkvp_zfilter.o : gkvp_zfilter.f90 gkvp_clock.o gkvp_mpienv.o gkvp_header.o - $(FC) $(FFLAGS) -c $< -$(MATH).o : $(MYL)$(MATH).f90 $(MYL)Bessel0_Zeros.f90 gkvp_header.o - $(FC) $(FFLAGS) -c $< -#------------------------------< + $(FC) $(FFLAGS) \ + gkvp_header.o\ + gkvp_mpienv.o\ + $(MATH).o\ + gkvp_clock.o\ + $(FILEIO).o\ + gkvp_intgrl.o\ + gkvp_tips.o\ + gkvp_vmecbzx.o\ + gkvp_igs.o\ + gkvp_ring.o\ + gkvp_bndry.o\ + gkvp_colli.o\ + $(FFT).o\ + gkvp_fld.o\ + gkvp_colliimp.o\ + gkvp_freq.o\ + gkvp_zfilter.o\ + gkvp_geom.o\ + gkvp_exb.o\ + gkvp_trans.o\ + gkvp_advnc.o\ + gkvp_shearflow.o\ + gkvp_dtc.o\ + gkvp_out.o\ + gkvp_set.o\ + gkvp_main.o\ + -o $(PROG) $(LIB) + + cp *.o *.mod *.$(OPTRPT) ../src/ + rm -f *.o *.mod *.$(OPTRPT) clean: - rm -f ../src/Makefile ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ + rm -f ../src/*.o ../src/*.mod ../src/*.$(OPTRPT) ./*.exe ./sub.q.*.o* \ ./*.o ./*.mod ./*.$(OPTRPT) ./*namelist.* ./sub.q.* clear: diff --git a/run/backup/Makefile_flow b/run/backup/Makefile_flow index e28c901..71a0a2c 100644 --- a/run/backup/Makefile_flow +++ b/run/backup/Makefile_flow @@ -50,6 +50,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(SRC)gkvp_tips.f90\ $(SRC)gkvp_vmecbzx.f90\ $(SRC)gkvp_igs.f90\ + $(SRC)gkvp_ring.f90\ $(SRC)gkvp_bndry.f90\ $(SRC)gkvp_colli.f90\ $(SRC)$(FFT).f90\ @@ -57,6 +58,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(SRC)gkvp_colliimp.f90\ $(SRC)gkvp_freq.f90\ $(SRC)gkvp_zfilter.f90\ + $(SRC)gkvp_geom.f90\ $(SRC)gkvp_exb.f90\ $(SRC)gkvp_trans.f90\ $(SRC)gkvp_advnc.f90\ @@ -75,6 +77,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_ring.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) @@ -82,6 +85,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 @@ -101,6 +105,7 @@ gkvp: $(SRC)gkvp_header.f90\ gkvp_tips.o\ gkvp_vmecbzx.o\ gkvp_igs.o\ + gkvp_ring.o\ gkvp_bndry.o\ gkvp_colli.o\ $(FFT).o\ @@ -108,6 +113,7 @@ gkvp: $(SRC)gkvp_header.f90\ gkvp_colliimp.o\ gkvp_freq.o\ gkvp_zfilter.o\ + gkvp_geom.o\ gkvp_exb.o\ gkvp_trans.o\ gkvp_advnc.o\ diff --git a/run/backup/Makefile_jfrs b/run/backup/Makefile_jfrs index 11ffec3..f771e28 100644 --- a/run/backup/Makefile_jfrs +++ b/run/backup/Makefile_jfrs @@ -61,6 +61,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(SRC)gkvp_tips.f90\ $(SRC)gkvp_vmecbzx.f90\ $(SRC)gkvp_igs.f90\ + $(SRC)gkvp_ring.f90\ $(SRC)gkvp_bndry.f90\ $(SRC)gkvp_colli.f90\ $(SRC)$(FFT).f90\ @@ -68,6 +69,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(SRC)gkvp_colliimp.f90\ $(SRC)gkvp_freq.f90\ $(SRC)gkvp_zfilter.f90\ + $(SRC)gkvp_geom.f90\ $(SRC)gkvp_exb.f90\ $(SRC)gkvp_trans.f90\ $(SRC)gkvp_advnc.f90\ @@ -87,6 +89,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(FC) $(FFLAGS) -c $(SRC)gkvp_tips.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_vmecbzx.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_igs.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_ring.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_bndry.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_colli.f90 $(FC) $(FFLAGS) -c $(SRC)$(FFT).f90 $(INC) @@ -94,6 +97,7 @@ gkvp: $(SRC)gkvp_header.f90\ $(FC) $(FFLAGS) -c $(SRC)gkvp_colliimp.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_freq.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_zfilter.f90 + $(FC) $(FFLAGS) -c $(SRC)gkvp_geom.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_exb.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_trans.f90 $(FC) $(FFLAGS) -c $(SRC)gkvp_advnc.f90 @@ -112,6 +116,7 @@ gkvp: $(SRC)gkvp_header.f90\ gkvp_tips.o\ gkvp_vmecbzx.o\ gkvp_igs.o\ + gkvp_ring.o\ gkvp_bndry.o\ gkvp_colli.o\ $(FFT).o\ @@ -119,6 +124,7 @@ gkvp: $(SRC)gkvp_header.f90\ gkvp_colliimp.o\ gkvp_freq.o\ gkvp_zfilter.o\ + gkvp_geom.o\ gkvp_exb.o\ gkvp_trans.o\ gkvp_advnc.o\ diff --git a/run/shoot b/run/shoot index 507eeea..ce833cd 100755 --- a/run/shoot +++ b/run/shoot @@ -14,10 +14,10 @@ if [ $# -lt 2 ]; then fi #### Environment setting -DIR=/data/lng/maeyama/gkvp/f0.62/dev_shearflow/dev19_gamma0.2_remap +DIR=/data/group1/z43460z/gkvp/f0.61/ITGae-lin LDM=gkvp.exe NL=gkvp_namelist -SC=qsub +SC=pjsub JS=sub.q ### For VMEC, set VMCDIR including metric_boozer.bin.dat #VMCDIR=./input_vmec/vmec_sample_nss501ntheta1024nzeta0 @@ -76,19 +76,15 @@ do #${SC} ${fln_JS} if [ -z "$j" -a $i -eq $1 ]; then echo "*** submit first step job ${fln_JS} ***" - ${SC} ${fln_JS} | tee shoottempfile - j=`awk '{sub(".nqsv*",""); print $2}' shoottempfile` + ${SC} --step --sparam "sn=$i" ${fln_JS} | tee shoottempfile + j=`awk '{sub("_.*",""); print $6}' shoottempfile` rm shoottempfile else echo "*** submit sequential step job ${fln_JS} ***" - ${SC} --after $j ${fln_JS} | tee shoottempfile - j=`awk '{sub(".nqsv*",""); print $2}' shoottempfile` - rm shoottempfile + ${SC} --step --sparam "jid=$j,sd=ec!=0:all" ${fln_JS} fi - sleep 1 i=$(( $i + 1 )) done - diff --git a/run/sub.q b/run/sub.q index d9cc221..6876642 100755 --- a/run/sub.q +++ b/run/sub.q @@ -1,65 +1,66 @@ -#!/bin/bash +#!/bin/sh ### NOTE ### -### Plasma simulator, NEC SX-Aurora TSUBASA A412-8 (NIFS, 2020) +### Flow supercomputer Type I sub-system, PRIMEHPC FX1000 (Nagoya Univ, 2020) ### -### - Computation nodes (total 4320 VE (Vector engine)) -### VE model: Type 10AE (8cores) -### Peak performance: DP 2.433 TFLOPS per VE -### Memory: HBM2 48 GiB -### Memory Bandwidth: ? GB/s per node +### - Computation nodes(total 2304 nodes) +### CPU: A64FX (2.0GHz, 12coresx4CMG=48cores, 512bit SIMD) x1 per node +### Peak performance: DP 3.379 TFLOPS per node (Boost: 3.3792 TFLOPS) +### Cache L1: 64 KiB, 4 way +### Cache L1 Bandwidth: 230+ GB/s(load), 115+ GB/s (store) +### Cache L2: 8 MiB, 16 way per CMG(NUMA), 4CMG per node +### Cache L2 Bandwidth: 3.6+ TB/s per node +### 115+ GB/s(load), 57+ GB/s(store) per core +### Memory: HBM2 32 GiB +### Memory Bandwidth: 1024 GB/s per node ### -### (For now, flat MPI is recommended.) +### Therefore, a recommended GKV parallelization may be +### (MPI Processes)x(12 OpenMP Threads) +### =(12 cores per CMG)x(4 CMG)x(Node numbers) +### 1 MPI process should be assigined to 1 CMG. ### ### - Interconnect -### Infiniband HDR200 x2, 1000BASE-Tx1, BMC +### Tofu Interconnect D (28 Gbps x 2 lane x 10 port) +### [Performance] 8B Put latency: 0.49-0.54 usec +### 1MiB Put throughput: 6.35 GB/s ### -### - Job class : Computation server (SX-Aurora) -### small : 1 - 16 VE, 15 min., 1 run/ 1 submit -### small24VE : 1 - 4 VE, 24 hour, 8 run/16 submit -### small24VH : 8 - 32 VE, 24 hour, 8 run/16 submit -### medium : 40 - 768 VE, 10 hour, 4 run/ 8 submit -### large : 1920 - 2160 VE, 10 hour, 1 run/ 4 submit -### large1h : 1920 - 2160 VE, 1 hour, 1 run/ 2 submit -### debug : 8 - 16 VE, 30 min., 1 run/ 1 submit, interactive -### -### - Job class : Data analysis server (LX) -### gpu-b : 1 - 4 Servers, 10 hour, 1 run/2 submit -### gpu-i : 1 - 2 Servers, 10 hour, 1 run/1 submit, interactive +### - Job class (May 2020) +### fx-debug : 1 - 36 nodes, 1 hour, 50 run/300 submit +### fx-small : 1 - 24 nodes, 168 hour, 100 run/300 submit +### fx-middle : 12 - 96 nodes, 72 hour, 50 run/300 submit +### fx-large : 96 - 192 nodes, 72 hour, 25 run/300 submit +### fx-xlarge : 96 - 768 nodes, 24 hour, 5 run/300 submit ### ### - Commands -### (Submit a batch job : "qsub sub.q") Use shoot script for GKV. -### Check job status : "qstat -a" -### Delete job : "qdel JOBID" -### Show budget info : "pstime" -### Show disk usage : "lsquota" +### (Submit a batch job : "pjsub sub.q") Use shoot script for GKV. +### Check job status : "pjstat" or "pjstat -E" for step jobs +### Delete job : "pjdel JOBID" +### Show budget info : "charge" +### Show disk usage : "lfs quota -u (YOUR ACCOUNT ID) /home" +### : "lfs quota -u (YOUR ACCOUNT ID) /data" ############## -#PBS -q small # queue name -#PBS --group=21234 # resource group -#PBS -T necmpi # necessary for MPI job -#PBS -l elapstim_req=00:15:00 # elapsed time limit - -#PBS --venode=2 # total number of VE -#### --venum-lhost=2 # number of VE per a logical node -#PBS --venum-lhost=8 # number of VE per a logical node -#PBS -v OMP_NUM_THREADS=1 # number of threads per MPI process +#PJM --rsc-list "rscgrp=fx-debug" +#PJM --rsc-list "node=8" +#### --rsc-list "node=5x8x8" +#PJM --rsc-list "elapse=00:10:00" +#PJM --mpi "proc=32" +#### --mpi "rank-map-bynode" +#### --mpi "rank-map-hostfile=rankmapfile.dat" +#PJM -j +#PJM -s -MPI_procs=16 # number of MPI processes (= venode*8 for flat MPI) +NUM_NODES=${PJM_NODE} # Nodes +NUM_CORES=12 # Cores per node +NUM_PROCS=$(( ${NUM_NODES} * 4 )) # MPI processes +export OMP_NUM_THREADS=12 # OpenMP threads per MPI -#PBS -v VE_FORT_SETBUF=10240 -#PBS -v FTRACE=YES -#PBS -v NMPI_PROGINF=DETAIL -#PBS -v NMPI_SEPSELECT=3 -#PBS -v LANG=C +echo " Nodes: ${NUM_NODES}" +echo " Cores per node: ${NUM_CORES}" +echo " MPI Processes: ${NUM_PROCS}" +echo " OpenMP threads per MPI: ${OMP_NUM_THREADS}" -source /ect/profile.d/modules.sh - -module load NECNLC-sx -# module load NECNLC-mpi-sx -### For NetCDF -module load netcdf-parallelIO-fortran-sx ### Working directory @@ -67,36 +68,60 @@ DIR=%%DIR%% LDM=gkvp.exe NL=gkvp_namelist.%%% +export XOS_MMM_L_PAGING_POLICY=demand:demand:demand # For Largepage -date -cd ${DIR} -export fu05=${DIR}/${NL} - +export PLE_MPI_STD_EMPTYFILE="off" # Suppress stdout of filesize-0 -#cat << 'EOF-S' > ./mpisep.sh -##!/bin/sh -#ulimit -s unlimited -#ID=${MPIUNIVERSE}.`printf "%05d" ${MPIRANK}` -#case ${NMPI_SEPSELECT:-${MPISEPSELECT:-2}} in -#1) exec $* 1>> stdout.${ID} ;; -#2) exec $* 2>> stderr.${ID} ;; -#3) exec $* 1>> stdout.${ID} 2>> stderr.${ID} ;; -#4) exec $* 1>> std.${ID} 2>&1 ;; -#*) exec $* ;; -#esac -#EOF-S -#chmod 777 ./mpisep.sh -# -##---( time mpiexec -v -nn ${_NECMPI_VH_NUM_NODES} -ve 0-7 -ppn 64 ./mpisep.sh ./${LDM} ) > log.mpi 2>&1 -#( time mpiexec -v -nn ${_NECMPI_VH_NUM_NODES} -ve 0-7 -ppn 64 -n ${MPI_procs} ./mpisep.sh ./${LDM} ) > log.mpi 2>&1 +module load fftw-tune phdf5 netcdf-c netcdf-fortran +###module unload tcs +###module load fftw/3.3.8 +###export PATH=/opt/FJSVxtclanga/tcsds-1.2.25/bin:$PATH +###export LD_LIBRARY_PATH=/opt/FJSVxtclanga/tcsds-1.2.25/lib64:$LD_LIBRARY_PATH +###export OPAL_PREFIX=/opt/FJSVxtclanga/tcsds-1.2.25 -mpirun -n ${MPI_procs} ${DIR}/${LDM} +#### Run +date +cd ${DIR} +export fu05=${DIR}/${NL} +mpiexec -n ${NUM_PROCS} ${DIR}/${LDM} + # -n "Total number of MPI processes" date -#touch complete - -#---#PBS -l coresz_prc=10 -#---#PBS --venum-lhost=8 -#---#PBS -b 4 # number of nodes +##### Run with Fujitsu profiler fipp (re-compile with -Nfjprof option) +#date +#cd ${DIR} +#export fu05=${DIR}/${NL} +#fipp -C -d ${DIR}/fjprof_dir/pa0 -Icpupa -Impi -Sregion mpiexec -n ${NUM_PROCS} ${DIR}/${LDM} +#date +#echo "#!/bin/sh" > ${DIR}/fjprof_dir/fugaku_fipppx.sh +#echo "set -Ceu" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh +#echo "set -x" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh +#echo "fipppx -A -d pa0 -Icpupa -p0,limit=4 -o prof_cpupa.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh +#echo "fipppx -A -d pa0 -Ibalance -p0,limit=4 -o prof_balance.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh +#echo "#fipppx -A -d pa0 -Icall -p0,limit=4 -o prof_call.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh +#echo "fipppx -A -d pa0 -Isrc:./src -p0,limit=4 -o prof_src.txt" >> ${DIR}/fjprof_dir/fugaku_fipppx.sh + + +##### Run with Fujitsu profiler fapp (re-compile with -Nfjprof option) +#date +#cd ${DIR} +#export fu05=${DIR}/${NL} +#Npa=1 # Elementary report +##Npa=5 # Simple report +##Npa=11 # Standard report +##Npa=17 # Detailed report +#for i in `seq 1 ${Npa}`; do +# echo "pa"${i} `date` +# fapp -C -d ${DIR}/fjprof_dir/pa${i} -Hevent=pa${i} -Sregion mpiexec -n ${NUM_PROCS} ${DIR}/${LDM} +#done +#date +# +#echo "#!/bin/sh" > ${DIR}/fjprof_dir/fugaku_fapppx.sh +#for i in `seq 1 ${Npa}`; do +# echo "fapppx -A -d ./pa${i} -Icpupa,mpi -tcsv -o pa${i}.csv" >> ${DIR}/fjprof_dir/fugaku_fapppx.sh +#done +#echo "cp /opt/FJSVxtclanga/tcsds-1.2.25/misc/cpupa/cpu_pa_report.xlsm ./" >> ${DIR}/fjprof_dir/fugaku_fapppx.sh +# +#