diff --git a/Makefile b/Makefile index 8d514dc..c405b8e 100644 --- a/Makefile +++ b/Makefile @@ -1,166 +1,166 @@ include local/dirs.inc include local/make.inc EXEC = $(BINDIR)/helaz F90 = mpiifort #F90 = ftn #for piz-daint cluster # Add Multiple-Precision Library EXTLIBS += -L$(FMDIR)/lib EXTINC += -I$(FMDIR)/mod EXTLIBS += -L$(FFTWDIR)/lib EXTINC += -I$(FFTWDIR)/include all: dirs src/srcinfo.h $(EXEC) install: dirs src/srcinfo.h $(EXEC) mvmod run: all (cd wk; $(EXEC);) dirs: mkdir -p $(BINDIR) mkdir -p $(OBJDIR) mkdir -p $(MODDIR) src/srcinfo.h: ( cd src/srcinfo; $(MAKE);) clean: cleanobj cleanmod @rm -f src/srcinfo.h @rm -f src/srcinfo/srcinfo.h cleanobj: @rm -f $(OBJDIR)/*o cleanmod: @rm -f $(MODDIR)/*mod @rm -f *.mod cleanbin: @rm -f $(EXEC) mvmod: mv *.mod mod/. $(OBJDIR)/diagnose.o : src/srcinfo.h FOBJ=$(OBJDIR)/advance_field.o $(OBJDIR)/array_mod.o $(OBJDIR)/auxval.o $(OBJDIR)/basic_mod.o \ $(OBJDIR)/coeff_mod.o $(OBJDIR)/closure_mod.o $(OBJDIR)/collision_mod.o \ $(OBJDIR)/compute_Sapj.o $(OBJDIR)/control.o $(OBJDIR)/fourier_mod.o \ $(OBJDIR)/diagnose.o $(OBJDIR)/diagnostics_par_mod.o $(OBJDIR)/endrun.o $(OBJDIR)/fields_mod.o \ $(OBJDIR)/inital.o $(OBJDIR)/initial_par_mod.o $(OBJDIR)/geometry_mod.o \ $(OBJDIR)/main.o $(OBJDIR)/memory.o $(OBJDIR)/model_mod.o $(OBJDIR)/moments_eq_rhs.o \ $(OBJDIR)/numerics_mod.o $(OBJDIR)/poisson.o $(OBJDIR)/ppexit.o $(OBJDIR)/ppinit.o $(OBJDIR)/prec_const_mod.o \ $(OBJDIR)/processing_mod.o $(OBJDIR)/readinputs.o $(OBJDIR)/ghosts_mod.o $(OBJDIR)/grid_mod.o \ $(OBJDIR)/restarts_mod.o $(OBJDIR)/stepon.o $(OBJDIR)/tesend.o $(OBJDIR)/time_integration_mod.o \ $(OBJDIR)/utility_mod.o $(EXEC): $(FOBJ) $(F90) $(LDFLAGS) $(OBJDIR)/*.o $(EXTMOD) $(EXTINC) $(EXTLIBS) -o $@ $(OBJDIR)/advance_field.o : src/advance_field.F90 $(OBJDIR)/grid_mod.o $(OBJDIR)/array_mod.o $(OBJDIR)/initial_par_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/fields_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/advance_field.F90 -o $@ $(OBJDIR)/array_mod.o : src/array_mod.F90 $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/array_mod.F90 -o $@ $(OBJDIR)/auxval.o : src/auxval.F90 $(OBJDIR)/fourier_mod.o $(OBJDIR)/memory.o $(OBJDIR)/model_mod.o $(OBJDIR)/geometry_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/numerics_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/auxval.F90 -o $@ $(OBJDIR)/basic_mod.o : src/basic_mod.F90 $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/basic_mod.F90 -o $@ $(OBJDIR)/coeff_mod.o : src/coeff_mod.F90 $(OBJDIR)/prec_const_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/basic_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/coeff_mod.F90 -o $@ $(OBJDIR)/closure_mod.o : src/closure_mod.F90 $(OBJDIR)/model_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/array_mod.o $(OBJDIR)/fields_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/closure_mod.F90 -o $@ $(OBJDIR)/collision_mod.o : src/collision_mod.F90 $(OBJDIR)/initial_par_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/utility_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/collision_mod.F90 -o $@ $(OBJDIR)/compute_Sapj.o : src/compute_Sapj.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/fourier_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/time_integration_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/compute_Sapj.F90 -o $@ $(OBJDIR)/control.o : src/control.F90 $(OBJDIR)/auxval.o $(OBJDIR)/geometry_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/ppexit.o $(OBJDIR)/ppinit.o $(OBJDIR)/readinputs.o $(OBJDIR)/tesend.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/control.F90 -o $@ $(OBJDIR)/diagnose.o : src/diagnose.F90 $(OBJDIR)/prec_const_mod.o $(OBJDIR)/processing_mod.o $(OBJDIR)/array_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/diagnostics_par_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/initial_par_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/time_integration_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/diagnose.F90 -o $@ $(OBJDIR)/diagnostics_par_mod.o : src/diagnostics_par_mod.F90 $(OBJDIR)/prec_const_mod.o $(OBJDIR)/basic_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/diagnostics_par_mod.F90 -o $@ $(OBJDIR)/endrun.o : src/endrun.F90 $(OBJDIR)/prec_const_mod.o $(OBJDIR)/basic_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/endrun.F90 -o $@ $(OBJDIR)/fields_mod.o : src/fields_mod.F90 $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/fields_mod.F90 -o $@ $(OBJDIR)/fourier_mod.o : src/fourier_mod.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/fourier_mod.F90 -o $@ $(OBJDIR)/ghosts_mod.o : src/ghosts_mod.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/ppinit.o $(OBJDIR)/time_integration_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/ghosts_mod.F90 -o $@ $(OBJDIR)/grid_mod.o : src/grid_mod.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/grid_mod.F90 -o $@ $(OBJDIR)/inital.o : src/inital.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/initial_par_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/numerics_mod.o $(OBJDIR)/poisson.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/ghosts_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/restarts_mod.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/utility_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/inital.F90 -o $@ $(OBJDIR)/initial_par_mod.o : src/initial_par_mod.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/initial_par_mod.F90 -o $@ - $(OBJDIR)/geometry_mod.o : src/geometry_mod.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/prec_const_mod.o + $(OBJDIR)/geometry_mod.o : src/geometry_mod.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/utility_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/geometry_mod.F90 -o $@ $(OBJDIR)/main.o : src/main.F90 $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/main.F90 -o $@ $(OBJDIR)/memory.o : src/memory.F90 $ $(OBJDIR)/array_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/grid_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/memory.F90 -o $@ $(OBJDIR)/model_mod.o : src/model_mod.F90 $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/model_mod.F90 -o $@ $(OBJDIR)/moments_eq_rhs.o : src/moments_eq_rhs.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/time_integration_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/moments_eq_rhs.F90 -o $@ $(OBJDIR)/numerics_mod.o : src/numerics_mod.F90 $(OBJDIR)/prec_const_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/coeff_mod.o $(OBJDIR)/utility_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/numerics_mod.F90 -o $@ $(OBJDIR)/poisson.o : src/poisson.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/array_mod.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/basic_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/poisson.F90 -o $@ $(OBJDIR)/ppexit.o : src/ppexit.F90 $(OBJDIR)/prec_const_mod.o $(OBJDIR)/basic_mod.o $(OBJDIR)/coeff_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/ppexit.F90 -o $@ $(OBJDIR)/ppinit.o : src/ppinit.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/array_mod.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/basic_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/ppinit.F90 -o $@ $(OBJDIR)/prec_const_mod.o : src/prec_const_mod.F90 $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/prec_const_mod.F90 -o $@ $(OBJDIR)/processing_mod.o : src/processing_mod.F90 $(OBJDIR)/array_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/basic_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/processing_mod.F90 -o $@ $(OBJDIR)/readinputs.o : src/readinputs.F90 $(OBJDIR)/diagnostics_par_mod.o $(OBJDIR)/initial_par_mod.o $(OBJDIR)/model_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/time_integration_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/readinputs.F90 -o $@ $(OBJDIR)/restarts_mod.o : src/restarts_mod.F90 $(OBJDIR)/diagnostics_par_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/time_integration_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/restarts_mod.F90 -o $@ $(OBJDIR)/stepon.o : src/stepon.F90 $(OBJDIR)/initial_par_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/advance_field.o $(OBJDIR)/basic_mod.o $(OBJDIR)/grid_mod.o $(OBJDIR)/array_mod.o $(OBJDIR)/numerics_mod.o $(OBJDIR)/fields_mod.o $(OBJDIR)/ghosts_mod.o $(OBJDIR)/moments_eq_rhs.o $(OBJDIR)/poisson.o $(OBJDIR)/time_integration_mod.o $(OBJDIR)/utility_mod.o $(OBJDIR)/model_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/stepon.F90 -o $@ $(OBJDIR)/tesend.o : src/tesend.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/tesend.F90 -o $@ $(OBJDIR)/time_integration_mod.o : src/time_integration_mod.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/prec_const_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/time_integration_mod.F90 -o $@ $(OBJDIR)/utility_mod.o : src/utility_mod.F90 $(OBJDIR)/basic_mod.o $(OBJDIR)/prec_const_mod.o $(OBJDIR)/grid_mod.o $(F90) -c $(F90FLAGS) $(FPPFLAGS) $(EXTMOD) $(EXTINC) src/utility_mod.F90 -o $@ diff --git a/matlab/extract_fig_data.m b/matlab/extract_fig_data.m index 65b13c9..32ac436 100644 --- a/matlab/extract_fig_data.m +++ b/matlab/extract_fig_data.m @@ -1,10 +1,10 @@ fig = gcf; axObjs = fig.Children; dataObjs = axObjs.Children; X_ = dataObjs(1).XData; Y_ = dataObjs(1).YData; figure; plot(X_,Y_); -plot(X_(9000:12000)-X_(8000),Y_(9000:12000)); \ No newline at end of file +plot(X_-X_(1),Y_); \ No newline at end of file diff --git a/matlab/load_params.m b/matlab/load_params.m index 1b0abf4..fe3e992 100644 --- a/matlab/load_params.m +++ b/matlab/load_params.m @@ -1,61 +1,64 @@ CO = h5readatt(filename,'/data/input','CO'); % K_N = h5readatt(filename,'/data/input','eta_n'); % K_T = h5readatt(filename,'/data/input','eta_T'); -K_N = h5readatt(filename,'/data/input','K_n'); -K_T = h5readatt(filename,'/data/input','K_T'); -K_E = h5readatt(filename,'/data/input','K_E'); +K_N = h5readatt(filename,'/data/input','K_n'); +K_T = h5readatt(filename,'/data/input','K_T'); +K_E = h5readatt(filename,'/data/input','K_E'); +Q0 = h5readatt(filename,'/data/input','q0'); +SHEAR = h5readatt(filename,'/data/input','shear'); +EPS = h5readatt(filename,'/data/input','eps'); PMAXI = h5readatt(filename,'/data/input','pmaxi'); JMAXI = h5readatt(filename,'/data/input','jmaxi'); PMAXE = h5readatt(filename,'/data/input','pmaxe'); JMAXE = h5readatt(filename,'/data/input','jmaxe'); NON_LIN = h5readatt(filename,'/data/input','NON_LIN'); NU = h5readatt(filename,'/data/input','nu'); Nx = h5readatt(filename,'/data/input','Nx'); Ny = h5readatt(filename,'/data/input','Ny'); L = h5readatt(filename,'/data/input','Lx'); CLOS = h5readatt(filename,'/data/input','CLOS'); DT_SIM = h5readatt(filename,'/data/input','dt'); MU = h5readatt(filename,'/data/input','mu'); % MU = str2num(filename(end-18:end-14)); %bad... W_GAMMA = h5readatt(filename,'/data/input','write_gamma') == 'y'; W_PHI = h5readatt(filename,'/data/input','write_phi') == 'y'; W_NA00 = h5readatt(filename,'/data/input','write_Na00') == 'y'; W_NAPJ = h5readatt(filename,'/data/input','write_Napj') == 'y'; W_SAPJ = h5readatt(filename,'/data/input','write_Sapj') == 'y'; if NON_LIN == 'y' NON_LIN = 1; else NON_LIN = 0; end switch abs(CO) case 0; CONAME = 'LB'; case 1; CONAME = 'DG'; case 2; CONAME = 'SG'; case 3; CONAME = 'PA'; case 4; CONAME = 'FC'; otherwise; CONAME ='UK'; end if (CO <= 0); CONAME = [CONAME,'DK']; else; CONAME = [CONAME,'GK']; end if (CLOS == 0); CLOSNAME = 'Trunc.'; elseif(CLOS == 1); CLOSNAME = 'Clos. 1'; elseif(CLOS == 2); CLOSNAME = 'Clos. 2'; end if (PMAXE == PMAXI) && (JMAXE == JMAXI) degngrad = ['P_',num2str(PMAXE),'_J_',num2str(JMAXE)]; else degngrad = ['Pe_',num2str(PMAXE),'_Je_',num2str(JMAXE),... '_Pi_',num2str(PMAXI),'_Ji_',num2str(JMAXI)]; end degngrad = [degngrad,'_Kn_%1.1f_nu_%0.0e_',... CONAME,'_CLOS_',num2str(CLOS),'_mu_%0.0e']; degngrad = sprintf(degngrad,[K_N,NU,MU]); if ~NON_LIN; degngrad = ['lin_',degngrad]; end resolution = [num2str(Nx),'x',num2str(Ny/2),'_']; gridname = ['L_',num2str(L),'_']; PARAMS = [resolution,gridname,degngrad]; % BASIC.RESDIR = [SIMDIR,PARAMS,'/']; diff --git a/matlab/load_results.m b/matlab/load_results.m index 81bac62..ad16253 100644 --- a/matlab/load_results.m +++ b/matlab/load_results.m @@ -1,56 +1,68 @@ %% load results %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% disp(['Loading ',filename]) % Loading from output file CPUTIME = h5readatt(filename,'/data/input','cpu_time'); DT_SIM = h5readatt(filename,'/data/input','dt'); [Pe, Je, Pi, Ji, kx, ky, z] = load_grid_data(filename); W_GAMMA = strcmp(h5readatt(filename,'/data/input','write_gamma'),'y'); W_HF = 0;%strcmp(h5readatt(filename,'/data/input','write_hf' ),'y'); W_PHI = strcmp(h5readatt(filename,'/data/input','write_phi' ),'y'); W_NA00 = strcmp(h5readatt(filename,'/data/input','write_Na00' ),'y'); W_NAPJ = strcmp(h5readatt(filename,'/data/input','write_Napj' ),'y'); W_SAPJ = strcmp(h5readatt(filename,'/data/input','write_Sapj' ),'y'); W_DENS = strcmp(h5readatt(filename,'/data/input','write_dens' ),'y'); W_TEMP = strcmp(h5readatt(filename,'/data/input','write_temp' ),'y'); +% KIN_E = strcmp(h5readatt(filename,'/data/input', 'KIN_E' ),'y'); +KIN_E = 1; if W_GAMMA [ GGAMMA_RI, Ts0D, dt0D] = load_0D_data(filename, 'gflux_ri'); PGAMMA_RI = load_0D_data(filename, 'pflux_ri'); end if W_HF [ HFLUX_X, Ts0D, dt0D] = load_0D_data(filename, 'hflux_x'); end if W_PHI [ PHI, Ts3D, dt3D] = load_3D_data(filename, 'phi'); end if W_NA00 [Ni00, Ts3D, dt3D] = load_3D_data(filename, 'Ni00'); + if(KIN_E) Ne00 = load_3D_data(filename, 'Ne00'); + end end if W_NAPJ [Nipj, Ts5D, dt5D] = load_5D_data(filename, 'moments_i'); + if(KIN_E) [Nepj ] = load_5D_data(filename, 'moments_e'); + end end if W_SAPJ [Sipj, Ts5D, dt5D] = load_5D_data(filename, 'Sipj'); + if(KIN_E) Sepj = load_5D_data(filename, 'Sepj'); + end end if W_DENS + if(KIN_E) [DENS_E, Ts3D, dt3D] = load_3D_data(filename, 'dens_e'); + end [DENS_I, Ts3D, dt3D] = load_3D_data(filename, 'dens_i'); end if W_TEMP + if(KIN_E) [TEMP_E, Ts3D, dt3D] = load_3D_data(filename, 'temp_e'); + end [TEMP_I, Ts3D, dt3D] = load_3D_data(filename, 'temp_i'); end \ No newline at end of file diff --git a/matlab/post_processing.m b/matlab/post_processing.m index 434be93..1cccc49 100644 --- a/matlab/post_processing.m +++ b/matlab/post_processing.m @@ -1,216 +1,215 @@ %% Retrieving max polynomial degree and sampling info Npe = numel(Pe); Nje = numel(Je); [JE,PE] = meshgrid(Je,Pe); Npi = numel(Pi); Nji = numel(Ji); [JI,PI] = meshgrid(Ji,Pi); Ns5D = numel(Ts5D); Ns3D = numel(Ts3D); % renaming and reshaping quantity of interest Ts5D = Ts5D'; Ts3D = Ts3D'; %% Build grids Nkx = numel(kx); Nky = numel(ky); [KY,KX] = meshgrid(ky,kx); Lkx = max(kx)-min(kx); Lky = max(ky)-min(ky); dkx = Lkx/(Nkx-1); dky = Lky/(Nky-1); KPERP2 = KY.^2+KX.^2; [~,ikx0] = min(abs(kx)); [~,iky0] = min(abs(ky)); [KY_XY,KX_XY] = meshgrid(ky,kx); [KZ_XZ,KX_XZ] = meshgrid(z,kx); [KZ_YZ,KY_YZ] = meshgrid(z,ky); Nx = 2*(Nkx-1); Ny = Nky; Nz = numel(z); Lx = 2*pi/dkx; Ly = 2*pi/dky; dx = Lx/Nx; dy = Ly/Ny; dz = 2*pi/Nz; x = dx*(-Nx/2:(Nx/2-1)); Lx = max(x)-min(x); y = dy*(-Ny/2:(Ny/2-1)); Ly = max(y)-min(y); -z = dz * (1:Nz); [Y_XY,X_XY] = meshgrid(y,x); [Z_XZ,X_XZ] = meshgrid(z,x); [Z_YZ,Y_YZ] = meshgrid(z,y); %% Analysis %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% disp('Analysis :') disp('- iFFT') % IFFT (Lower case = real space, upper case = frequency space) ne00 = zeros(Nx,Ny,Nz,Ns3D); % Gyrocenter density ni00 = zeros(Nx,Ny,Nz,Ns3D); % " phi = zeros(Nx,Ny,Nz,Ns3D); % Electrostatic potential Z_phi = zeros(Nx,Ny,Nz,Ns3D); % Zonal " dens_e = zeros(Nx,Ny,Nz,Ns3D); % Particle density dens_i = zeros(Nx,Ny,Nz,Ns3D); %" Z_n_e = zeros(Nx,Ny,Nz,Ns3D); % Zonal " Z_n_i = zeros(Nx,Ny,Nz,Ns3D); %" temp_e = zeros(Nx,Ny,Nz,Ns3D); % Temperature temp_i = zeros(Nx,Ny,Nz,Ns3D); % " Z_T_e = zeros(Nx,Ny,Nz,Ns3D); % Zonal " Z_T_i = zeros(Nx,Ny,Nz,Ns3D); %" dyTe = zeros(Nx,Ny,Nz,Ns3D); % Various derivatives dyTi = zeros(Nx,Ny,Nz,Ns3D); % " dyni = zeros(Nx,Ny,Nz,Ns3D); % " dxphi = zeros(Nx,Ny,Nz,Ns3D); % " dyphi = zeros(Nx,Ny,Nz,Ns3D); % " dx2phi = zeros(Nx,Ny,Nz,Ns3D); % " for it = 1:numel(Ts3D) for iz = 1:numel(z) NE_ = Ne00(:,:,iz,it); NI_ = Ni00(:,:,iz,it); PH_ = PHI(:,:,iz,it); ne00 (:,:,iz,it) = real(fftshift(ifft2((NE_),Nx,Ny))); ni00 (:,:,iz,it) = real(fftshift(ifft2((NI_),Nx,Ny))); phi (:,:,iz,it) = real(fftshift(ifft2((PH_),Nx,Ny))); Z_phi (:,:,iz,it) = real(fftshift(ifft2((PH_.*(KY==0)),Nx,Ny))); dxphi (:,:,iz,it) = real(fftshift(ifft2(1i*KX.*(PH_),Nx,Ny))); dx2phi(:,:,iz,it) = real(fftshift(ifft2(-KX.^2.*(PH_),Nx,Ny))); dyphi (:,:,iz,it) = real(fftshift(ifft2(1i*KY.*(PH_),Nx,Ny))); if(W_DENS) DENS_E_ = DENS_E(:,:,iz,it); DENS_I_ = DENS_I(:,:,iz,it); dyni (:,:,iz,it) = real(fftshift(ifft2(1i*KY.*(DENS_I_),Nx,Ny))); dens_e (:,:,iz,it) = real(fftshift(ifft2((DENS_E_),Nx,Ny))); dens_i (:,:,iz,it) = real(fftshift(ifft2((DENS_I_),Nx,Ny))); Z_n_e (:,:,iz,it) = real(fftshift(ifft2((DENS_E_.*(KY==0)),Nx,Ny))); Z_n_i (:,:,iz,it) = real(fftshift(ifft2((DENS_I_.*(KY==0)),Nx,Ny))); end if(W_TEMP) TEMP_E_ = TEMP_E(:,:,iz,it); TEMP_I_ = TEMP_I(:,:,iz,it); dyTe(:,:,iz,it) = real(fftshift(ifft2(1i*KY.*(TEMP_E_),Nx,Ny))); dyTi(:,:,iz,it) = real(fftshift(ifft2(1i*KY.*(TEMP_I_),Nx,Ny))); temp_e (:,:,iz,it) = real(fftshift(ifft2((TEMP_E_),Nx,Ny))); temp_i (:,:,iz,it) = real(fftshift(ifft2((TEMP_I_),Nx,Ny))); Z_T_e (:,:,iz,it) = real(fftshift(ifft2((TEMP_E_.*(KY==0)),Nx,Ny))); Z_T_i (:,:,iz,it) = real(fftshift(ifft2((TEMP_I_.*(KY==0)),Nx,Ny))); end end end % Post processing disp('- post processing') % particle flux Gamma_x= zeros(Nx,Ny,Nz,Ns3D); % Radial particle transport Gamma_y= zeros(Nx,Ny,Nz,Ns3D); % Azymuthal particle transport % heat flux Q_x = zeros(Nx,Ny,Nz,Ns3D); Q_y = zeros(Nx,Ny,Nz,Ns3D); % Epot averages phi_maxx_maxy = zeros(Nz,Ns3D); % Time evol. of the norm of phi phi_avgx_maxy = zeros(Nz,Ns3D); % Time evol. of the norm of phi phi_maxx_avgy = zeros(Nz,Ns3D); % Time evol. of the norm of phi phi_avgx_avgy = zeros(Nz,Ns3D); % Time evol. of the norm of phi shear_maxx_maxy = zeros(Nz,Ns3D); % Time evol. of the norm of shear shear_avgx_maxy = zeros(Nz,Ns3D); % Time evol. of the norm of shear shear_maxx_avgy = zeros(Nz,Ns3D); % Time evol. of the norm of shear shear_avgx_avgy = zeros(Nz,Ns3D); % Time evol. of the norm of shear Ne_norm = zeros(Pe_max,Je_max,Ns5D); % Time evol. of the norm of Napj Ni_norm = zeros(Pi_max,Ji_max,Ns5D); % . % Kperp spectrum interpolation %full kperp points kperp = reshape(sqrt(KX.^2+KY.^2),[numel(KX),1]); % interpolated kperps nk_noAA = floor(2/3*numel(kx)); kp_ip = kx; [thg, rg] = meshgrid(linspace(0,pi,2*nk_noAA),kp_ip); [xn,yn] = pol2cart(thg,rg); [ky_s, sortIdx] = sort(ky); [xc,yc] = meshgrid(ky_s,kx); phi_kp_t = zeros(numel(kp_ip),Nz,Ns3D); % for it = 1:numel(Ts3D) % Loop over 2D aX_XYays for iz = 1:numel(z) NE_ = Ne00(:,:,iz,it); NI_ = Ni00(:,:,iz,it); PH_ = PHI(:,:,iz,it); phi_maxx_maxy(iz,it) = max( max(squeeze(phi(:,:,iz,it)))); phi_avgx_maxy(iz,it) = max(mean(squeeze(phi(:,:,iz,it)))); phi_maxx_avgy(iz,it) = mean( max(squeeze(phi(:,:,iz,it)))); phi_avgx_avgy(iz,it) = mean(mean(squeeze(phi(:,:,iz,it)))); if(W_DENS) Gamma_x(:,:,iz,it) = -dens_i(:,:,iz,it).*dyphi(:,:,iz,it); Gamma_y(:,:,iz,it) = dens_i(:,:,iz,it).*dxphi(:,:,iz,it); end if(W_TEMP) Q_x(:,:,iz,it) = -temp_e(:,:,iz,it).*dyphi(:,:,iz,it); Q_y(:,:,iz,it) = temp_i(:,:,iz,it).*dxphi(:,:,iz,it); end shear_maxx_maxy(iz,it) = max( max(squeeze(-(dx2phi(:,:,iz,it))))); shear_avgx_maxy(iz,it) = max(mean(squeeze(-(dx2phi(:,:,iz,it))))); shear_maxx_avgy(iz,it) = mean( max(squeeze(-(dx2phi(:,:,iz,it))))); shear_avgx_avgy(iz,it) = mean(mean(squeeze(-(dx2phi(:,:,iz,it))))); Z_rth = interp2(xc,yc,squeeze(mean((abs(PHI(:,sortIdx,iz,it))).^2,3)),xn,yn); phi_kp_t(:,iz,it) = mean(Z_rth,2); end end % for it = 1:numel(Ts5D) % Loop over 5D aX_XYays [~, it2D] = min(abs(Ts3D-Ts5D(it))); Ne_norm(:,:,it)= sum(sum(abs(Nepj(:,:,:,:,it)),3),4)/Nkx/Nky; Ni_norm(:,:,it)= sum(sum(abs(Nipj(:,:,:,:,it)),3),4)/Nkx/Nky; end %% Compute primary instability growth rate -disp('- growth rate') -% Find max value of transport (end of linear mode) -[tmp,tmax] = max(GGAMMA_RI*(2*pi/Nx/Ny)^2); -[~,itmax] = min(abs(Ts3D-tmax)); -tstart = 0.1 * Ts3D(itmax); tend = 0.5 * Ts3D(itmax); -[~,its3D_lin] = min(abs(Ts3D-tstart)); -[~,ite3D_lin] = min(abs(Ts3D-tend)); - -g_I = zeros(Nkx,Nky,Nz); -for ikx = 1:Nkx - for iky = 1:Nky - for iz = 1:Nz - [g_I(ikx,iky,iz), ~] = LinearFit_s(Ts3D(its3D_lin:ite3D_lin)',squeeze(abs(Ni00(ikx,iky,iz,its3D_lin:ite3D_lin)))); - end - end -end -[gmax_I,ikmax_I] = max(max(g_I(1,:,:),[],2),[],3); -kmax_I = abs(ky(ikmax_I)); -Bohm_transport = K_N*gmax_I/kmax_I^2; +% disp('- growth rate') +% % Find max value of transport (end of linear mode) +% [tmp,tmax] = max(GGAMMA_RI*(2*pi/Nx/Ny)^2); +% [~,itmax] = min(abs(Ts3D-tmax)); +% tstart = 0.1 * Ts3D(itmax); tend = 0.5 * Ts3D(itmax); +% [~,its3D_lin] = min(abs(Ts3D-tstart)); +% [~,ite3D_lin] = min(abs(Ts3D-tend)); +% +% g_I = zeros(Nkx,Nky,Nz); +% for ikx = 1:Nkx +% for iky = 1:Nky +% for iz = 1:Nz +% [g_I(ikx,iky,iz), ~] = LinearFit_s(Ts3D(its3D_lin:ite3D_lin)',squeeze(abs(Ni00(ikx,iky,iz,its3D_lin:ite3D_lin)))); +% end +% end +% end +% [gmax_I,ikmax_I] = max(max(g_I(1,:,:),[],2),[],3); +% kmax_I = abs(ky(ikmax_I)); +% Bohm_transport = K_N*gmax_I/kmax_I^2; %% Compute secondary instability growth rate -disp('- growth rate') -% Find max value of transport (end of linear mode) -% [tmp,tmax] = max(GGAMMA_RI*(2*pi/Nx/Ny)^2); -% [~,itmax] = min(abs(Ts2D-tmax)); -% tstart = Ts2D(itmax); tend = 1.5*Ts2D(itmax); -[~,its3D_lin] = min(abs(Ts3D-tstart)); -[~,ite3D_lin] = min(abs(Ts3D-tend)); - -g_II = zeros(Nkx,Nky); -for ikx = 1:Nkx - for iky = 1 - for iz = 1:Nz - [g_II(ikx,iky,iz), ~] = LinearFit_s(Ts3D(its3D_lin:ite3D_lin)',squeeze(abs(Ni00(ikx,iky,iz,its3D_lin:ite3D_lin)))); - end - end -end -[gmax_II,ikmax_II] = max(max(g_II(1,:,:),[],2),[],3); -kmax_II = abs(kx(ikmax_II)); +% disp('- growth rate') +% % Find max value of transport (end of linear mode) +% % [tmp,tmax] = max(GGAMMA_RI*(2*pi/Nx/Ny)^2); +% % [~,itmax] = min(abs(Ts2D-tmax)); +% % tstart = Ts2D(itmax); tend = 1.5*Ts2D(itmax); +% [~,its3D_lin] = min(abs(Ts3D-tstart)); +% [~,ite3D_lin] = min(abs(Ts3D-tend)); +% +% g_II = zeros(Nkx,Nky); +% for ikx = 1:Nkx +% for iky = 1 +% for iz = 1:Nz +% [g_II(ikx,iky,iz), ~] = LinearFit_s(Ts3D(its3D_lin:ite3D_lin)',squeeze(abs(Ni00(ikx,iky,iz,its3D_lin:ite3D_lin)))); +% end +% end +% end +% [gmax_II,ikmax_II] = max(max(g_II(1,:,:),[],2),[],3); +% kmax_II = abs(kx(ikmax_II)); %% zonal vs nonzonal energies for phi(t) Ephi_Z = zeros(1,Ns3D); Ephi_NZ_kgt0 = zeros(1,Ns3D); Ephi_NZ_kgt1 = zeros(1,Ns3D); Ephi_NZ_kgt2 = zeros(1,Ns3D); high_k_phi = zeros(1,Ns3D); for it = 1:numel(Ts3D) % Ephi_NZ(it) = sum(sum(((KY~=0).*abs(PHI(:,:,1,it)).^2))); % Ephi_Z(it) = sum(sum(((KY==0).*abs(PHI(:,:,1,it)).^2))); [amp,ikzf] = max(abs((kx~=0).*PHI(:,1,1,it))); % Ephi_NZ(it) = sum(sum(((KX~=0).*(KY~=0).*(KX.^2+KY.^2).*abs(PHI(:,:,1,it)).^2))); Ephi_NZ_kgt0(it) = squeeze(sum(sum(((sqrt(KX.^2+KY.^2)>0.0).*(KX~=0).*(KY~=0).*(KX.^2+KY.^2).*abs(PHI(:,:,1,it)).^2)))); Ephi_NZ_kgt1(it) = squeeze(sum(sum(((sqrt(KX.^2+KY.^2)>1.0).*(KX~=0).*(KY~=0).*(KX.^2+KY.^2).*abs(PHI(:,:,1,it)).^2)))); Ephi_NZ_kgt2(it) = squeeze(sum(sum(((sqrt(KX.^2+KY.^2)>2.0).*(KX~=0).*(KY~=0).*(KX.^2+KY.^2).*abs(PHI(:,:,1,it)).^2)))); % Ephi_Z(it) = kx(ikzf)^2*abs(PHI(ikzf,1,1,it)).^2; Ephi_Z(it) = squeeze(sum(sum(((KX~=0).*(KY==0).*(KX.^2).*abs(PHI(:,:,1,it)).^2)))); % Ephi_NZ(it) = sum(sum(((KX.^2+KY.^2).*abs(PHI(:,:,1,it)).^2)))-Ephi_Z(it); - high_k_phi(it) = squeeze(abs(PHI(18,18,1,it)).^2); % kperp sqrt(2) +% high_k_phi(it) = squeeze(abs(PHI(18,18,1,it)).^2); % kperp sqrt(2) % high_k_phi(it) = abs(PHI(40,40,1,it)).^2;% kperp 3.5 end diff --git a/matlab/setup.m b/matlab/setup.m index e272a4f..a9a1f15 100644 --- a/matlab/setup.m +++ b/matlab/setup.m @@ -1,170 +1,174 @@ %% ________________________________________________________________________ SIMDIR = ['../results/',SIMID,'/']; % Grid parameters GRID.pmaxe = PMAXE; % Electron Hermite moments GRID.jmaxe = JMAXE; % Electron Laguerre moments GRID.pmaxi = PMAXI; % Ion Hermite moments GRID.jmaxi = JMAXI; % Ion Laguerre moments -GRID.Nx = Nx; % x grid resolution -GRID.Lx = Lx; % x length -GRID.Ny = Ny; % y '' -GRID.Ly = Ly; % y '' -GRID.Nz = Nz; % z resolution -GRID.q0 = q0; % q factor -GRID.shear = shear; % shear -GRID.eps = eps; % inverse aspect ratio +GRID.Nx = NX; % x grid resolution +GRID.Lx = LX; % x length +GRID.Ny = NY; % y '' +GRID.Ly = LY; % y '' +GRID.Nz = NZ; % z resolution +GRID.q0 = Q0; % q factor +GRID.shear = SHEAR; % shear +GRID.eps = EPS; % inverse aspect ratio % Model parameters MODEL.CO = CO; % Collision operator (0 : L.Bernstein, -1 : Full Coulomb, -2 : Dougherty) MODEL.CLOS = CLOS; MODEL.NL_CLOS = NL_CLOS; if NON_LIN; MODEL.NON_LIN = '.true.'; else; MODEL.NON_LIN = '.false.';end; +MODEL.KIN_E = KIN_E; +if KIN_E; MODEL.KIN_E = '.true.'; else; MODEL.KIN_E = '.false.';end; MODEL.mu = MU; MODEL.mu_p = MU_P; MODEL.mu_j = MU_J; MODEL.nu = NU; % hyper diffusive coefficient nu for HW % temperature ratio T_a/T_e MODEL.tau_e = TAU; MODEL.tau_i = TAU; % mass ratio sqrt(m_a/m_i) MODEL.sigma_e = SIGMA_E; MODEL.sigma_i = 1.0; % charge q_a/e MODEL.q_e =-1.0; MODEL.q_i = 1.0; if MODEL.q_e == 0; SIMID = [SIMID,'_i']; end; % gradients L_perp/L_x MODEL.K_n = K_N; % source term kappa for HW MODEL.K_T = K_T; % Temperature MODEL.K_E = K_E; % Electric MODEL.GradB = GRADB; % Magnetic gradient MODEL.CurvB = CURVB; % Magnetic curvature MODEL.lambdaD = LAMBDAD; % if A0KH ~= 0; SIMID = [SIMID,'_Nz_',num2str(L/2/pi*KX0KH),'_A_',num2str(A0KH)]; end; % Time integration and intialization parameters TIME_INTEGRATION.numerical_scheme = '''RK4'''; if (INIT_PHI); INITIAL.init_noisy_phi = '.true.'; else; INITIAL.init_noisy_phi = '.false.';end; INITIAL.INIT_ZF = INIT_ZF; INITIAL.wipe_turb = WIPE_TURB; INITIAL.wipe_zf = WIPE_ZF; if (INIT_BLOB); INITIAL.init_blob = '.true.'; else; INITIAL.init_blob = '.false.';end; INITIAL.init_background = (INIT_ZF>0)*ZF_AMP + BCKGD0; INITIAL.init_noiselvl = NOISE0; INITIAL.iseed = 42; INITIAL.mat_file = '''null'''; if (abs(CO) == 2) %Sugama operator INITIAL.mat_file = ['''../../../iCa/gk_sugama_P_20_J_10_N_150_kpm_8.0.h5''']; elseif (abs(CO) == 3) %pitch angle operator INITIAL.mat_file = ['''../../../iCa/gk_pitchangle_8_P_20_J_10_N_150_kpm_8.0.h5''']; elseif (CO == 4) % Full Coulomb GK % INITIAL.mat_file = ['''../../../iCa/gk_coulomb_NFLR_12_P_4_J_2_N_50_kpm_4.0.h5''']; INITIAL.mat_file = ['''../../../iCa/gk_coulomb_NFLR_12_P_4_J_2_N_75_kpm_6.0.h5''']; % INITIAL.mat_file = ['''../../../iCa/gk_coulomb_NFLR_6_P_4_J_2_N_50_kpm_4.0.h5''']; % INITIAL.mat_file = ['''../../../iCa/gk_coulomb_NFLR_6_P_4_J_2_N_75_kpm_6.0.h5''']; elseif (CO == -1) % DGDK disp('Warning, DGDK not debugged') end % Naming and creating input file switch abs(CO) case 0; CONAME = 'LB'; case 1; CONAME = 'DG'; case 2; CONAME = 'SG'; case 3; CONAME = 'PA'; case 4; CONAME = 'FC'; otherwise; CONAME ='UK'; end if (CO <= 0); CONAME = [CONAME,'DK']; else; CONAME = [CONAME,'GK']; end if (CLOS == 0); CLOSNAME = 'Trunc.'; elseif(CLOS == 1); CLOSNAME = 'Clos. 1'; elseif(CLOS == 2); CLOSNAME = 'Clos. 2'; end % Hermite-Laguerre degrees naming if (PMAXE == PMAXI) && (JMAXE == JMAXI) HLdeg_ = ['_',num2str(PMAXE+1),'x',num2str(JMAXE+1)]; else HLdeg_ = ['_Pe_',num2str(PMAXE+1),'_Je_',num2str(JMAXE+1),... '_Pi_',num2str(PMAXI+1),'_Ji_',num2str(JMAXI+1)]; end % temp. dens. drives drives_ = []; if abs(K_N) > 0; drives_ = [drives_,'_kN_',num2str(K_N)]; end; if abs(K_T) > 0; drives_ = [drives_,'_kT_',num2str(K_T)]; end; % collision coll_ = ['_nu_%0.0e_',CONAME]; coll_ = sprintf(coll_,NU); % nonlinear lin_ = []; if ~NON_LIN; lin_ = '_lin'; end +adiabe_ = []; +if ~KIN_E; adiabe_ = '_adiabe'; end % resolution and boxsize res_ = [num2str(GRID.Nx),'x',num2str(GRID.Ny)]; -if (Lx ~= Ly) - geo_ = ['_Lx_',num2str(Lx),'_Ly_',num2str(Ly)]; +if (LX ~= LY) + geo_ = ['_Lx_',num2str(LX),'_Ly_',num2str(LY)]; else - geo_ = ['_L_',num2str(Lx)]; + geo_ = ['_L_',num2str(LX)]; end -if (Nz > 1) %3D case - res_ = [res_,'x',num2str(GRID.Nz)]; - if abs(q0) > 0 - geo_ = [geo_,'_q0_',num2str(q0)]; +if (NZ > 1) %3D case + res_ = [res_,'x',num2str(NZ)]; + if abs(Q0) > 0 + geo_ = [geo_,'_q0_',num2str(Q0)]; end - if abs(eps) > 0 - geo_ = [geo_,'_e_',num2str(eps)]; + if abs(EPS) > 0 + geo_ = [geo_,'_e_',num2str(EPS)]; end - if abs(shear) > 0 - geo_ = [geo_,'_s_',num2str(shear)]; + if abs(SHEAR) > 0 + geo_ = [geo_,'_s_',num2str(SHEAR)]; end end % put everything together in the param character chain u_ = '_'; % underscore variable -PARAMS = [res_,HLdeg_,geo_,drives_,coll_,lin_]; +PARAMS = [res_,HLdeg_,geo_,drives_,coll_,lin_,adiabe_]; BASIC.RESDIR = [SIMDIR,PARAMS,'/']; BASIC.MISCDIR = ['/misc/HeLaZ_outputs/',SIMDIR(4:end),PARAMS,'/']; BASIC.PARAMS = PARAMS; BASIC.SIMID = SIMID; BASIC.nrun = 1e8; BASIC.dt = DT; BASIC.tmax = TMAX; %time normalized to 1/omega_pe BASIC.maxruntime = str2num(CLUSTER.TIME(1:2))*3600 ... + str2num(CLUSTER.TIME(4:5))*60 ... + str2num(CLUSTER.TIME(7:8)); % Outputs parameters OUTPUTS.nsave_0d = floor(1.0/SPS0D/DT); OUTPUTS.nsave_1d = -1; OUTPUTS.nsave_2d = floor(1.0/SPS2D/DT); OUTPUTS.nsave_3d = floor(1.0/SPS3D/DT); OUTPUTS.nsave_5d = floor(1.0/SPS5D/DT); if W_DOUBLE; OUTPUTS.write_doubleprecision = '.true.'; else; OUTPUTS.write_doubleprecision = '.false.';end; if W_GAMMA; OUTPUTS.write_gamma = '.true.'; else; OUTPUTS.write_gamma = '.false.';end; if W_HF; OUTPUTS.write_hf = '.true.'; else; OUTPUTS.write_hf = '.false.';end; if W_PHI; OUTPUTS.write_phi = '.true.'; else; OUTPUTS.write_phi = '.false.';end; if W_NA00; OUTPUTS.write_Na00 = '.true.'; else; OUTPUTS.write_Na00 = '.false.';end; if W_NAPJ; OUTPUTS.write_Napj = '.true.'; else; OUTPUTS.write_Napj = '.false.';end; if W_SAPJ; OUTPUTS.write_Sapj = '.true.'; else; OUTPUTS.write_Sapj = '.false.';end; if W_DENS; OUTPUTS.write_dens = '.true.'; else; OUTPUTS.write_dens = '.false.';end; if W_TEMP; OUTPUTS.write_temp = '.true.'; else; OUTPUTS.write_temp = '.false.';end; OUTPUTS.job2load = JOB2LOAD; %% Create directories if ~exist(SIMDIR, 'dir') mkdir(SIMDIR) end if ~exist(BASIC.RESDIR, 'dir') mkdir(BASIC.RESDIR) end if ~exist(BASIC.MISCDIR, 'dir') mkdir(BASIC.MISCDIR) end %% Compile and WRITE input file INPUT = write_fort90(OUTPUTS,GRID,MODEL,INITIAL,TIME_INTEGRATION,BASIC); nproc = 1; MAKE = 'cd ..; make; cd wk'; % system(MAKE); %% disp(['Set up ',SIMID]); disp([res_,geo_,HLdeg_]); if JOB2LOAD>=0 disp(['- restarting from JOBNUM = ',num2str(JOB2LOAD)]); else disp(['- starting from T = 0']); end diff --git a/matlab/write_fort90.m b/matlab/write_fort90.m index 5787348..84259b0 100644 --- a/matlab/write_fort90.m +++ b/matlab/write_fort90.m @@ -1,88 +1,89 @@ function [INPUT] = write_fort90(OUTPUTS,GRID,MODEL,INITIAL,TIME_INTEGRATION,BASIC) % Write the input script "fort.90" with desired parameters INPUT = ['fort_',sprintf('%2.2d',OUTPUTS.job2load+1),'.90']; fid = fopen(INPUT,'wt'); fprintf(fid,'&BASIC\n'); fprintf(fid,[' nrun = ', num2str(BASIC.nrun),'\n']); fprintf(fid,[' dt = ', num2str(BASIC.dt),'\n']); fprintf(fid,[' tmax = ', num2str(BASIC.tmax),'\n']); fprintf(fid,[' maxruntime = ', num2str(BASIC.maxruntime),'\n']); fprintf(fid,'/\n'); fprintf(fid,'&GRID\n'); fprintf(fid,[' pmaxe = ', num2str(GRID.pmaxe),'\n']); fprintf(fid,[' jmaxe = ', num2str(GRID.jmaxe),'\n']); fprintf(fid,[' pmaxi = ', num2str(GRID.pmaxi),'\n']); fprintf(fid,[' jmaxi = ', num2str(GRID.jmaxi),'\n']); fprintf(fid,[' Nx = ', num2str(GRID.Nx),'\n']); fprintf(fid,[' Lx = ', num2str(GRID.Lx),'\n']); fprintf(fid,[' Ny = ', num2str(GRID.Ny),'\n']); fprintf(fid,[' Ly = ', num2str(GRID.Ly),'\n']); fprintf(fid,[' Nz = ', num2str(GRID.Nz),'\n']); fprintf(fid,[' q0 = ', num2str(GRID.q0),'\n']); fprintf(fid,[' shear = ', num2str(GRID.shear),'\n']); fprintf(fid,[' eps = ', num2str(GRID.eps),'\n']); fprintf(fid,'/\n'); fprintf(fid,'&OUTPUT_PAR\n'); fprintf(fid,[' nsave_0d = ', num2str(OUTPUTS.nsave_0d),'\n']); fprintf(fid,[' nsave_1d = ', num2str(OUTPUTS.nsave_1d),'\n']); fprintf(fid,[' nsave_2d = ', num2str(OUTPUTS.nsave_2d),'\n']); fprintf(fid,[' nsave_3d = ', num2str(OUTPUTS.nsave_3d),'\n']); fprintf(fid,[' nsave_5d = ', num2str(OUTPUTS.nsave_5d),'\n']); fprintf(fid,[' write_doubleprecision = ', OUTPUTS.write_doubleprecision,'\n']); fprintf(fid,[' write_gamma = ', OUTPUTS.write_gamma,'\n']); fprintf(fid,[' write_hf = ', OUTPUTS.write_hf,'\n']); fprintf(fid,[' write_phi = ', OUTPUTS.write_phi,'\n']); fprintf(fid,[' write_Na00 = ', OUTPUTS.write_Na00,'\n']); fprintf(fid,[' write_Napj = ', OUTPUTS.write_Napj,'\n']); fprintf(fid,[' write_Sapj = ', OUTPUTS.write_Sapj,'\n']); fprintf(fid,[' write_dens = ', OUTPUTS.write_dens,'\n']); fprintf(fid,[' write_temp = ', OUTPUTS.write_temp,'\n']); fprintf(fid,[' job2load = ', num2str(OUTPUTS.job2load),'\n']); fprintf(fid,'/\n'); fprintf(fid,'&MODEL_PAR\n'); fprintf(fid,' ! Collisionality\n'); fprintf(fid,[' CO = ', num2str(MODEL.CO),'\n']); fprintf(fid,[' CLOS = ', num2str(MODEL.CLOS),'\n']); fprintf(fid,[' NL_CLOS = ', num2str(MODEL.NL_CLOS),'\n']); fprintf(fid,[' NON_LIN = ', MODEL.NON_LIN,'\n']); +fprintf(fid,[' KIN_E = ', MODEL.KIN_E,'\n']); fprintf(fid,[' mu = ', num2str(MODEL.mu),'\n']); fprintf(fid,[' mu_p = ', num2str(MODEL.mu_p),'\n']); fprintf(fid,[' mu_j = ', num2str(MODEL.mu_j),'\n']); fprintf(fid,[' nu = ', num2str(MODEL.nu),'\n']); fprintf(fid,[' tau_e = ', num2str(MODEL.tau_e),'\n']); fprintf(fid,[' tau_i = ', num2str(MODEL.tau_i),'\n']); fprintf(fid,[' sigma_e = ', num2str(MODEL.sigma_e),'\n']); fprintf(fid,[' sigma_i = ', num2str(MODEL.sigma_i),'\n']); fprintf(fid,[' q_e = ', num2str(MODEL.q_e),'\n']); fprintf(fid,[' q_i = ', num2str(MODEL.q_i),'\n']); fprintf(fid,[' K_n = ', num2str(MODEL.K_n),'\n']); fprintf(fid,[' K_T = ', num2str(MODEL.K_T),'\n']); fprintf(fid,[' K_E = ', num2str(MODEL.K_E),'\n']); fprintf(fid,[' GradB = ', num2str(MODEL.GradB),'\n']); fprintf(fid,[' CurvB = ', num2str(MODEL.CurvB),'\n']); fprintf(fid,[' lambdaD = ', num2str(MODEL.lambdaD),'\n']); fprintf(fid,'/\n'); fprintf(fid,'&INITIAL_CON\n'); fprintf(fid,[' INIT_NOISY_PHI = ', INITIAL.init_noisy_phi,'\n']); fprintf(fid,[' INIT_ZF = ', num2str(INITIAL.INIT_ZF),'\n']); fprintf(fid,[' WIPE_ZF = ', num2str(INITIAL.wipe_zf),'\n']); fprintf(fid,[' WIPE_TURB = ', num2str(INITIAL.wipe_turb),'\n']); fprintf(fid,[' INIT_BLOB = ', INITIAL.init_blob,'\n']); fprintf(fid,[' init_background = ', num2str(INITIAL.init_background),'\n']); fprintf(fid,[' init_noiselvl = ', num2str(INITIAL.init_noiselvl),'\n']); fprintf(fid,[' iseed = ', num2str(INITIAL.iseed),'\n']); fprintf(fid,[' mat_file = ', INITIAL.mat_file,'\n']); fprintf(fid,'/\n'); fprintf(fid,'&TIME_INTEGRATION_PAR\n'); fprintf(fid,[' numerical_scheme = ', TIME_INTEGRATION.numerical_scheme,'\n']); fprintf(fid,'/'); fclose(fid); system(['cp fort*.90 ',BASIC.RESDIR,'/.']); end diff --git a/src/advance_field.F90 b/src/advance_field.F90 index 4f0aa5b..5e8c87d 100644 --- a/src/advance_field.F90 +++ b/src/advance_field.F90 @@ -1,91 +1,93 @@ MODULE advance_field_routine USE prec_const implicit none CONTAINS SUBROUTINE advance_time_level USE basic USE time_integration use prec_const IMPLICIT NONE CALL set_updatetlevel(mod(updatetlevel,ntimelevel)+1) END SUBROUTINE advance_time_level SUBROUTINE advance_moments USE basic USE time_integration USE grid use prec_const - USE model, ONLY: CLOS + USE model, ONLY: CLOS, KIN_E use fields, ONLY: moments_e, moments_i use array, ONLY: moments_rhs_e, moments_rhs_i IMPLICIT NONE INTEGER :: p_int, j_int CALL cpu_time(t0_adv_field) - DO ip=ips_e,ipe_e - p_int = parray_e(ip) - DO ij=ijs_e,ije_e - IF((CLOS .NE. 1) .OR. (ip-1+2*(ij-1)+1 .LE. dmaxe))& - CALL advance_field(moments_e(ip,ij,:,:,:,:), moments_rhs_e(ip,ij,:,:,:,:)) + IF(KIN_E) THEN + DO ip=ips_e,ipe_e + p_int = parray_e(ip) + DO ij=ijs_e,ije_e + IF((CLOS .NE. 1) .OR. (ip-1+2*(ij-1)+1 .LE. dmaxe))& + CALL advance_field(moments_e(ip,ij,:,:,:,:), moments_rhs_e(ip,ij,:,:,:,:)) + ENDDO ENDDO - ENDDO + ENDIF DO ip=ips_i,ipe_i p_int = parray_i(ip) DO ij=ijs_i,ije_i j_int = jarray_i(ij) IF((CLOS .NE. 1) .OR. (ip-1+2*(ij-1)+1 .LE. dmaxi))& CALL advance_field(moments_i(ip,ij,:,:,:,:), moments_rhs_i(ip,ij,:,:,:,:)) ENDDO ENDDO ! Execution time end CALL cpu_time(t1_adv_field) tc_adv_field = tc_adv_field + (t1_adv_field - t0_adv_field) END SUBROUTINE advance_moments SUBROUTINE advance_field( f, f_rhs ) USE basic USE time_integration USE array USE grid use prec_const use initial_par, ONLY: WIPE_ZF IMPLICIT NONE COMPLEX(dp), DIMENSION ( ikxs:ikxe, ikys:ikye, izs:ize, ntimelevel ) :: f COMPLEX(dp), DIMENSION ( ikxs:ikxe, ikys:ikye, izs:ize, ntimelevel ) :: f_rhs INTEGER :: istage SELECT CASE (updatetlevel) CASE(1) DO iky=ikys,ikye DO ikx=ikxs,ikxe DO iz=izs,ize DO istage=1,ntimelevel f(ikx,iky,iz,1) = f(ikx,iky,iz,1) + dt*b_E(istage)*f_rhs(ikx,iky,iz,istage) END DO END DO END DO END DO CASE DEFAULT DO iky=ikys,ikye DO ikx=ikxs,ikxe DO iz=izs,ize f(ikx,iky,iz,updatetlevel) = f(ikx,iky,iz,1); DO istage=1,updatetlevel-1 f(ikx,iky,iz,updatetlevel) = f(ikx,iky,iz,updatetlevel) + & dt*A_E(updatetlevel,istage)*f_rhs(ikx,iky,iz,istage) END DO END DO END DO END DO END SELECT END SUBROUTINE advance_field END MODULE advance_field_routine diff --git a/src/array_mod.F90 b/src/array_mod.F90 index 9c14fcd..668a95b 100644 --- a/src/array_mod.F90 +++ b/src/array_mod.F90 @@ -1,79 +1,79 @@ MODULE array use prec_const implicit none ! Arrays to store the rhs, for time integration (ip,ij,ikx,iky,iz,updatetlevel) COMPLEX(dp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: moments_rhs_e COMPLEX(dp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: moments_rhs_i ! Arrays of non-adiabatique moments COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: nadiab_moments_e COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: nadiab_moments_i ! Non linear term array (ip,ij,ikx,iky,iz) COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: Sepj ! electron COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: Sipj ! ion ! To load collision matrix (ip1,ij1,ip2,ij2) REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: Ceepj, CeipjT REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: CeipjF REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: Ciipj, CiepjT REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: CiepjF ! Collision term (ip,ij,ikx,iky,iz) COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: TColl_e, TColl_i COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: TColl_e_local, TColl_i_local ! dnjs coefficient storage (in, ij, is) COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: dnjs ! lin rhs p,j coefficient storage (ip,ij) REAL(dp), DIMENSION(:,:), ALLOCATABLE :: xnepj,xnipj REAL(dp), DIMENSION(:), ALLOCATABLE :: xnepp1j, xnepm1j, xnepp2j, xnepm2j, xnepjp1, xnepjm1 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ynepp1j, ynepm1j, ynepp1jm1, ynepm1jm1 ! mirror lin coeff for non adiab mom REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zNepm1j, zNepm1jp1, zNepm1jm1 ! mirror lin coeff for adiab mom REAL(dp), DIMENSION(:), ALLOCATABLE :: xnipp1j, xnipm1j, xnipp2j, xnipm2j, xnipjp1, xnipjm1 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ynipp1j, ynipm1j, ynipp1jm1, ynipm1jm1 ! mirror lin coeff for non adiab mom REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zNipm1j, zNipm1jp1, zNipm1jm1 ! mirror lin coeff for adiab mom REAL(dp), DIMENSION(:,:), ALLOCATABLE :: xphij, xphijp1, xphijm1 ! Geoemtrical operators ! Curvature REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ckxky ! dimensions: kx, ky, z - ! kperp array - REAL(dp), DIMENSION(:,:,:), ALLOCATABLE, PUBLIC :: kparray ! dimensions: kx, ky, z ! Jacobian REAL(dp), DIMENSION(:), ALLOCATABLE :: Jacobian ! dimensions: z ! Metric REAL(dp), DIMENSION(:), ALLOCATABLE :: gxx, gxy, gyy, gxz, gyz ! derivatives of magnetic field strength REAL(dp), DIMENSION(:), allocatable :: gradzB ! dimensions: z REAL(dp), DIMENSION(:), allocatable :: gradxB ! Relative magnetic field strength REAL(dp), DIMENSION(:), allocatable :: hatB ! Relative strength of major radius REAL(dp), DIMENSION(:), allocatable :: hatR ! Geometrical factors REAL(dp), DIMENSION(:), allocatable :: Gamma1 REAL(dp), DIMENSION(:), allocatable :: Gamma2 REAL(dp), DIMENSION(:), allocatable :: Gamma3 ! Some geometrical coefficients REAL(dp), DIMENSION(:) , allocatable :: gradz_coeff ! 1 / [ J_{xyz} \hat{B} ] ! Kernel function evaluation (ij,ikx,iky,iz) REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: kernel_e REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: kernel_i + ! Poisson operator (ikx,iky,iz) + REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: inv_poisson_op !! Diagnostics ! Gyrocenter density for electron and ions (ikx,iky,iz) COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ne00 COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ni00 ! particle density for electron and ions (ikx,iky,iz) COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: dens_e COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: dens_i ! particle temperature for electron and ions (ikx,iky,iz) COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: temp_e COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: temp_i END MODULE array diff --git a/src/auxval.F90 b/src/auxval.F90 index ea051ab..8e642f6 100644 --- a/src/auxval.F90 +++ b/src/auxval.F90 @@ -1,78 +1,80 @@ subroutine auxval ! Set auxiliary values, at beginning of simulation USE basic USE grid USE array USE model USE fourier, ONLY: init_grid_distr_and_plans, alloc_local_1, alloc_local_2 use prec_const USE numerics USE geometry IMPLICIT NONE INTEGER :: irows,irowe, irow, icol, i_ IF (my_id .EQ. 0) WRITE(*,*) '=== Set auxiliary values ===' IF (NON_LIN) THEN CALL init_grid_distr_and_plans(Nx,Ny) ELSE CALL init_1Dgrid_distr ENDIF ! Init the grids CALL set_pgrid ! parallel kin (MPI distributed) - + CALL set_jgrid ! perp kin CALL set_kxgrid ! radial modes (MPI distributed by FFTW) CALL set_kygrid ! azymuthal modes CALL set_zgrid ! field aligned angle CALL memory ! Allocate memory for global arrays CALL eval_magnetic_geometry ! precompute coeff for lin equation CALL compute_lin_coeff ! precompute coeff for lin equation and geometry CALL evaluate_kernels ! precompute the kernels + CALL evaluate_poisson_op ! precompute the kernels + IF ( NON_LIN ) THEN; CALL build_dnjs_table ! precompute the Laguerre nonlin product coeffs ENDIF !! Display parallel settings DO i_ = 0,num_procs-1 CALL mpi_barrier(MPI_COMM_WORLD, ierr) IF (my_id .EQ. i_) THEN IF (my_id .EQ. 0) WRITE(*,*) '' IF (my_id .EQ. 0) WRITE(*,*) '--------- Parallel environement ----------' IF (my_id .EQ. 0) WRITE(*,'(A9,I3,A10,I3,A10,I3)') 'n_procs= ', num_procs, ', num_procs_p = ', num_procs_p, ', num_procs_kx = ', num_procs_kx IF (my_id .EQ. 0) WRITE(*,*) '' WRITE(*,'(A9,I3,A10,I3,A10,I3)')& 'my_id = ', my_id, ', rank_p = ', rank_p, ', rank_kx = ', rank_kx WRITE(*,'(A22,I3,A11,I3)')& ' ips_e = ', ips_e, ', ipe_e = ', ipe_e WRITE(*,'(A22,I3,A11,I3)')& ' ijs_e = ', ijs_e, ', ije_e = ', ije_e WRITE(*,'(A22,I3,A11,I3)')& ' ips_i = ', ips_i, ', ipe_i = ', ipe_i WRITE(*,'(A22,I3,A11,I3)')& ' ijs_i = ', ijs_i, ', ije_i = ', ije_i WRITE(*,'(A22,I3,A11,I3)')& ' ikxs = ', ikxs , ', ikxe = ', ikxe WRITE(*,'(A22,I3,A11,I3)')& ' ikys = ', ikys , ', ikye = ', ikye WRITE(*,'(A22,I3,A11,I3)')& ' izs = ', izs , ', ize = ', ize ! write(*,*) 'local kx =', kxarray ! write(*,*) 'local ky =', kyarray ! write(*,*) 'local iz =', izarray IF (my_id .NE. num_procs-1) WRITE (*,*) '' IF (my_id .EQ. num_procs-1) WRITE(*,*) '------------------------------------------' ENDIF ENDDO CALL mpi_barrier(MPI_COMM_WORLD, ierr) END SUBROUTINE auxval diff --git a/src/closure_mod.F90 b/src/closure_mod.F90 index d3c4820..4b124fc 100644 --- a/src/closure_mod.F90 +++ b/src/closure_mod.F90 @@ -1,103 +1,106 @@ module closure ! Contains the routines to define closures USE basic -USE model, ONLY: CLOS, tau_e, tau_i, q_e, q_i, nu +USE model, ONLY: CLOS, tau_e, tau_i, q_e, q_i, nu, KIN_E USE grid USE array, ONLY: kernel_e, kernel_i USE fields, ONLY: moments_e, moments_i USE time_integration, ONLY: updatetlevel IMPLICIT NONE PUBLIC :: apply_closure_model, ghosts_truncation CONTAINS ! Positive Oob indices are approximated with a model SUBROUTINE apply_closure_model IMPLICIT NONE CALL cpu_time(t0_clos) IF (CLOS .EQ. 0) THEN ! zero truncation, An+1=0 for n+1>nmax only CALL ghosts_truncation ELSEIF (CLOS .EQ. 1) THEN ! Truncation at highest fully represented kinetic moment ! e.g. Dmax = 3 means ! all Napj s.t. p+2j <= 3 ! -> (p,j) allowed are (0,0),(1,0),(0,1),(2,0),(1,1),(3,0) ! =>> Dmax is Pmax, condition is p+2j<=Pmax DO ikx = ikxs,ikxe DO iky = ikys,ikye DO iz = izs,ize + IF(KIN_E) THEN DO ip = ipsg_e,ipeg_e DO ij = ijsg_e,ijeg_e IF ( parray_e(ip)+2*jarray_e(ip) .GT. dmaxe) & moments_e(ip,ij,ikx,iky,iz,updatetlevel) = 0._dp ENDDO ENDDO + ENDIF DO ip = ipsg_i,ipeg_i DO ij = ijsg_i,ijeg_i IF ( parray_i(ip)+2*jarray_i(ip) .GT. dmaxi) & moments_i(ip,ij,ikx,iky,iz,updatetlevel) = 0._dp ENDDO ENDDO ENDDO ENDDO ENDDO ! + ghosts truncation CALL ghosts_truncation ELSE if(my_id .EQ. 0) write(*,*) '! Closure scheme not found !' ENDIF CALL cpu_time(t1_clos) tc_clos = tc_clos + (t1_clos - t0_clos) END SUBROUTINE apply_closure_model ! Positive Oob indices are approximated with a model SUBROUTINE ghosts_truncation IMPLICIT NONE ! zero truncation, An+1=0 for n+1>nmax DO ikx = ikxs,ikxe DO iky = ikys,ikye DO iz = izs,ize + IF(KIN_E) THEN DO ip = ipsg_e,ipeg_e moments_e(ip,ijsg_e,ikx,iky,iz,updatetlevel) = 0._dp moments_e(ip,ijeg_e,ikx,iky,iz,updatetlevel) = 0._dp ENDDO DO ij = ijsg_e,ijeg_e moments_e(ipsg_e ,ij,ikx,iky,iz,updatetlevel) = 0._dp moments_e(ipeg_e ,ij,ikx,iky,iz,updatetlevel) = 0._dp IF(deltape .EQ. 1) THEN ! Must truncate the second stencil moments_e(ipsg_e+1,ij,ikx,iky,iz,updatetlevel) = 0._dp moments_e(ipeg_e-1,ij,ikx,iky,iz,updatetlevel) = 0._dp ENDIF ENDDO kernel_e(ijsg_e,ikx,iky,iz) = 0._dp kernel_e(ijeg_e,ikx,iky,iz) = 0._dp - + ENDIF DO ip = ipsg_i,ipeg_i moments_i(ip,ijsg_i,ikx,iky,iz,updatetlevel) = 0._dp moments_i(ip,ijeg_i,ikx,iky,iz,updatetlevel) = 0._dp ENDDO DO ij = ijsg_i,ijeg_i moments_i(ipsg_i ,ij,ikx,iky,iz,updatetlevel) = 0._dp moments_i(ipeg_i ,ij,ikx,iky,iz,updatetlevel) = 0._dp IF(deltapi .EQ. 1) THEN ! Must truncate the second stencil moments_i(ipsg_i+1,ij,ikx,iky,iz,updatetlevel) = 0._dp moments_i(ipeg_i-1,ij,ikx,iky,iz,updatetlevel) = 0._dp ENDIF ENDDO kernel_i(ijsg_i,ikx,iky,iz) = 0._dp kernel_i(ijeg_i,ikx,iky,iz) = 0._dp ENDDO ENDDO ENDDO END SUBROUTINE ghosts_truncation END module closure diff --git a/src/collision_mod.F90 b/src/collision_mod.F90 index 4a0a291..3d2bd67 100644 --- a/src/collision_mod.F90 +++ b/src/collision_mod.F90 @@ -1,744 +1,751 @@ module collision ! contains the Hermite-Laguerre collision operators. Solved using COSOlver. IMPLICIT NONE PUBLIC :: compute_TColl PUBLIC :: LenardBernstein_e, LenardBernstein_i!, LenardBernstein GK PUBLIC :: DoughertyGK_e, DoughertyGK_i!, Dougherty GK PUBLIC :: load_COSOlver_mat PUBLIC :: apply_COSOlver_mat_e, apply_COSOlver_mat_i CONTAINS !******************************************************************************! !! Lenard Bernstein collision operator for electrons !******************************************************************************! SUBROUTINE LenardBernstein_e(ip_,ij_,ikx_,iky_,iz_,TColl_) USE fields, ONLY: moments_e USE grid, ONLY: parray_e, jarray_e, kxarray, kyarray USE basic USE model, ONLY: sigmae2_taue_o2, nu_ee USE time_integration, ONLY : updatetlevel IMPLICIT NONE INTEGER, INTENT(IN) :: ip_,ij_,ikx_,iky_,iz_ COMPLEX(dp), INTENT(OUT) :: TColl_ REAL(dp) :: j_dp, p_dp, be_2 !** Auxiliary variables ** p_dp = REAL(parray_e(ip_),dp) j_dp = REAL(jarray_e(ij_),dp) ! be_2 = (kxarray(ikx_)**2 + kyarray(iky_)**2) * sigmae2_taue_o2 ! this is (be/2)^2 !** Assembling collison operator ** ! -nuee (p + 2j) Nepj TColl_ = -nu_ee * (p_dp + 2._dp*j_dp)*moments_e(ip_,ij_,ikx_,iky_,iz_,updatetlevel) END SUBROUTINE LenardBernstein_e !******************************************************************************! !! Lenard Bernstein collision operator for electrons !******************************************************************************! SUBROUTINE LenardBernstein_i(ip_,ij_,ikx_,iky_,iz_,TColl_) USE fields, ONLY: moments_i USE grid, ONLY: parray_i, jarray_i, kxarray, kyarray USE basic USE model, ONLY: sigmai2_taui_o2, nu_i USE time_integration, ONLY : updatetlevel IMPLICIT NONE INTEGER, INTENT(IN) :: ip_,ij_,ikx_,iky_,iz_ COMPLEX(dp), INTENT(OUT) :: TColl_ REAL(dp) :: j_dp, p_dp, bi_2 !** Auxiliary variables ** p_dp = REAL(parray_i(ip_),dp) j_dp = REAL(jarray_i(ij_),dp) ! bi_2 = (kxarray(ikx_)**2 + kyarray(iky_)**2) * sigmai2_taui_o2 ! this is (bi/2)^2 !** Assembling collison operator ** ! -nuii (p + 2j) Nipj TColl_ = -nu_i * (p_dp + 2._dp*j_dp)*moments_i(ip_,ij_,ikx_,iky_,iz_,updatetlevel) END SUBROUTINE LenardBernstein_i !******************************************************************************! !! Doughtery gyrokinetic collision operator for electrons !******************************************************************************! SUBROUTINE DoughertyGK_e(ip_,ij_,ikx_,iky_,iz_,TColl_) USE fields, ONLY: moments_e, phi - USE grid, ONLY: parray_e, jarray_e, kxarray, kyarray, Jmaxe, ip0_e, ip1_e, ip2_e - USE array, ONLY: kernel_e, kparray + USE grid, ONLY: parray_e, jarray_e, kxarray, kyarray, kparray, Jmaxe, ip0_e, ip1_e, ip2_e + USE array, ONLY: kernel_e USE basic USE model, ONLY: sigmae2_taue_o2, qe_taue, nu_ee, sqrt_sigmae2_taue_o2 USE time_integration, ONLY : updatetlevel IMPLICIT NONE INTEGER, INTENT(IN) :: ip_,ij_,ikx_,iky_,iz_ COMPLEX(dp), INTENT(OUT) :: TColl_ COMPLEX(dp) :: n_,upar_,uperp_,Tpar_, Tperp_, T_ COMPLEX(dp) :: nadiab_moment_0j REAL(dp) :: Knp0, Knp1, Knm1, kp INTEGER :: in_ REAL(dp) :: n_dp, j_dp, p_dp, be_, be_2 !** Auxiliary variables ** p_dp = REAL(parray_e(ip_),dp) j_dp = REAL(jarray_e(ij_),dp) kp = kparray(ikx_,iky_,iz_) be_2 = kp**2 * sigmae2_taue_o2 ! this is (be/2)^2 be_ = 2_dp*kp * sqrt_sigmae2_taue_o2 ! this is be !** Assembling collison operator ** ! Velocity-space diffusion (similar to Lenard Bernstein) ! -nuee (p + 2j + b^2/2) Nepj TColl_ = -(p_dp + 2._dp*j_dp + 2._dp*be_2)*moments_e(ip_,ij_,ikx_,iky_,iz_,updatetlevel) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IF( p_dp .EQ. 0 ) THEN ! Kronecker p0 ! Get adiabatic moment TColl_ = TColl_ - (p_dp + 2._dp*j_dp + 2._dp*be_2) * qe_taue * Kernel_e(ij_,ikx_,iky_,iz_)*phi(ikx_,iky_,iz_) !** build required fluid moments ** n_ = 0._dp upar_ = 0._dp; uperp_ = 0._dp Tpar_ = 0._dp; Tperp_ = 0._dp DO in_ = 1,jmaxe+1 n_dp = REAL(in_-1,dp) ! Store the kernels for sparing readings Knp0 = Kernel_e(in_ ,ikx_,iky_,iz_) Knp1 = Kernel_e(in_+1,ikx_,iky_,iz_) Knm1 = Kernel_e(in_-1,ikx_,iky_,iz_) ! Nonadiabatic moments (only different from moments when p=0) nadiab_moment_0j = moments_e(ip0_e,in_ ,ikx_,iky_,iz_,updatetlevel) + qe_taue*Knp0*phi(ikx_,iky_,iz_) ! Density n_ = n_ + Knp0 * nadiab_moment_0j ! Perpendicular velocity uperp_ = uperp_ + be_*0.5_dp*(Knp0 - Knm1) * nadiab_moment_0j ! Parallel temperature Tpar_ = Tpar_ + Knp0 * (SQRT2*moments_e(ip2_e,in_,ikx_,iky_,iz_,updatetlevel) + nadiab_moment_0j) ! Perpendicular temperature Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j ENDDO T_ = (Tpar_ + 2._dp*Tperp_)/3._dp - n_ ! Add energy restoring term TColl_ = TColl_ + T_* 4._dp * j_dp * Kernel_e(ij_ ,ikx_,iky_,iz_) TColl_ = TColl_ - T_* 2._dp * (j_dp + 1._dp) * Kernel_e(ij_+1,ikx_,iky_,iz_) TColl_ = TColl_ - T_* 2._dp * j_dp * Kernel_e(ij_-1,ikx_,iky_,iz_) TColl_ = TColl_ + uperp_*be_* (Kernel_e(ij_,ikx_,iky_,iz_) - Kernel_e(ij_-1,ikx_,iky_,iz_)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ELSEIF( p_dp .eq. 1 ) THEN ! kronecker p1 !** build required fluid moments ** upar_ = 0._dp DO in_ = 1,jmaxe+1 ! Parallel velocity upar_ = upar_ + Kernel_e(in_,ikx_,iky_,iz_) * moments_e(ip1_e,in_,ikx_,iky_,iz_,updatetlevel) ENDDO TColl_ = TColl_ + upar_*Kernel_e(ij_,ikx_,iky_,iz_) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ELSEIF( p_dp .eq. 2 ) THEN ! kronecker p2 !** build required fluid moments ** n_ = 0._dp upar_ = 0._dp; uperp_ = 0._dp Tpar_ = 0._dp; Tperp_ = 0._dp DO in_ = 1,jmaxe+1 n_dp = REAL(in_-1,dp) ! Store the kernels for sparing readings Knp0 = Kernel_e(in_ ,ikx_,iky_,iz_) Knp1 = Kernel_e(in_+1,ikx_,iky_,iz_) Knm1 = Kernel_e(in_-1,ikx_,iky_,iz_) ! Nonadiabatic moments (only different from moments when p=0) nadiab_moment_0j = moments_e(ip0_e,in_,ikx_,iky_,iz_,updatetlevel) + qe_taue*Knp0*phi(ikx_,iky_,iz_) ! Density n_ = n_ + Knp0 * nadiab_moment_0j ! Parallel temperature Tpar_ = Tpar_ + Knp0 * (SQRT2*moments_e(ip2_e,in_,ikx_,iky_,iz_,updatetlevel) + nadiab_moment_0j) ! Perpendicular temperature Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j ENDDO T_ = (Tpar_ + 2._dp*Tperp_)/3._dp - n_ TColl_ = TColl_ + T_*SQRT2*Kernel_e(ij_,ikx_,iky_,iz_) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ENDIF ! Multiply by electron-electron collision coefficient TColl_ = nu_ee * TColl_ END SUBROUTINE DoughertyGK_e !******************************************************************************! !! Doughtery gyrokinetic collision operator for ions !******************************************************************************! SUBROUTINE DoughertyGK_i(ip_,ij_,ikx_,iky_,iz_,TColl_) USE fields, ONLY: moments_i, phi - USE grid, ONLY: parray_i, jarray_i, kxarray, kyarray, Jmaxi, ip0_i, ip1_i, ip2_i - USE array, ONLY: kernel_i, kparray + USE grid, ONLY: parray_i, jarray_i, kxarray, kyarray, kparray, Jmaxi, ip0_i, ip1_i, ip2_i + USE array, ONLY: kernel_i USE basic USE model, ONLY: sigmai2_taui_o2, qi_taui, nu_i, sqrt_sigmai2_taui_o2 USE time_integration, ONLY : updatetlevel IMPLICIT NONE INTEGER, INTENT(IN) :: ip_,ij_,ikx_,iky_,iz_ COMPLEX(dp), INTENT(OUT) :: TColl_ COMPLEX(dp) :: n_,upar_,uperp_,Tpar_, Tperp_, T_ COMPLEX(dp) :: bi_, bi_2 COMPLEX(dp) :: nadiab_moment_0j REAL(dp) :: Knp0, Knp1, Knm1, kp INTEGER :: in_ REAL(dp) :: n_dp, j_dp, p_dp !** Auxiliary variables ** p_dp = REAL(parray_i(ip_),dp) j_dp = REAL(jarray_i(ij_),dp) kp = kparray(ikx_,iky_,iz_) bi_2 = kp**2 *sigmai2_taui_o2 ! this is (bi/2)^2 bi_ = 2_dp*kp*sqrt_sigmai2_taui_o2 ! this is bi !** Assembling collison operator ** ! Velocity-space diffusion (similar to Lenard Bernstein) ! -nui (p + 2j + b^2/2) Nipj TColl_ = -(p_dp + 2._dp*j_dp + 2._dp*bi_2)*moments_i(ip_,ij_,ikx_,iky_,iz_,updatetlevel) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IF( p_dp .EQ. 0 ) THEN ! Kronecker p0 ! Get adiabatic moment TColl_ = TColl_ - (p_dp + 2._dp*j_dp + 2._dp*bi_2) * qi_taui * Kernel_i(ij_,ikx_,iky_,iz_)*phi(ikx_,iky_,iz_) !** build required fluid moments ** n_ = 0._dp upar_ = 0._dp; uperp_ = 0._dp Tpar_ = 0._dp; Tperp_ = 0._dp DO in_ = 1,jmaxi+1 n_dp = REAL(in_-1,dp) ! Store the kernels for sparing readings Knp0 = Kernel_i(in_ ,ikx_,iky_,iz_) Knp1 = Kernel_i(in_+1,ikx_,iky_,iz_) Knm1 = Kernel_i(in_-1,ikx_,iky_,iz_) ! Nonadiabatic moments (only different from moments when p=0) nadiab_moment_0j = moments_i(ip0_i,in_ ,ikx_,iky_,iz_,updatetlevel) + qi_taui*Knp0*phi(ikx_,iky_,iz_) ! Density n_ = n_ + Knp0 * nadiab_moment_0j ! Perpendicular velocity uperp_ = uperp_ + bi_*0.5_dp*(Knp0 - Knm1) * nadiab_moment_0j ! Parallel temperature Tpar_ = Tpar_ + Knp0 * (SQRT2*moments_i(ip2_i,in_,ikx_,iky_,iz_,updatetlevel) + nadiab_moment_0j) ! Perpendicular temperature Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j ENDDO T_ = (Tpar_ + 2._dp*Tperp_)/3._dp - n_ ! Add energy restoring term TColl_ = TColl_ + T_* 4._dp * j_dp * Kernel_i(ij_ ,ikx_,iky_,iz_) TColl_ = TColl_ - T_* 2._dp * (j_dp + 1._dp) * Kernel_i(ij_+1,ikx_,iky_,iz_) TColl_ = TColl_ - T_* 2._dp * j_dp * Kernel_i(ij_-1,ikx_,iky_,iz_) TColl_ = TColl_ + uperp_*bi_* (Kernel_i(ij_,ikx_,iky_,iz_) - Kernel_i(ij_-1,ikx_,iky_,iz_)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ELSEIF( p_dp .eq. 1 ) THEN ! kxonecker p1 !** build required fluid moments ** upar_ = 0._dp DO in_ = 1,jmaxi+1 ! Parallel velocity upar_ = upar_ + Kernel_i(in_,ikx_,iky_,iz_) * moments_i(ip1_i,in_,ikx_,iky_,iz_,updatetlevel) ENDDO TColl_ = TColl_ + upar_*Kernel_i(ij_,ikx_,iky_,iz_) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ELSEIF( p_dp .eq. 2 ) THEN ! kxonecker p2 !** build required fluid moments ** n_ = 0._dp upar_ = 0._dp; uperp_ = 0._dp Tpar_ = 0._dp; Tperp_ = 0._dp DO in_ = 1,jmaxi+1 n_dp = REAL(in_-1,dp) ! Store the kernels for sparing readings Knp0 = Kernel_i(in_ ,ikx_,iky_,iz_) Knp1 = Kernel_i(in_+1,ikx_,iky_,iz_) Knm1 = Kernel_i(in_-1,ikx_,iky_,iz_) ! Nonadiabatic moments (only different from moments when p=0) nadiab_moment_0j = moments_i(ip0_i,in_,ikx_,iky_,iz_,updatetlevel) + qi_taui*Knp0*phi(ikx_,iky_,iz_) ! Density n_ = n_ + Knp0 * nadiab_moment_0j ! Parallel temperature Tpar_ = Tpar_ + Knp0 * (SQRT2*moments_i(ip2_i,in_,ikx_,iky_,iz_,updatetlevel) + nadiab_moment_0j) ! Perpendicular temperature Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j ENDDO T_ = (Tpar_ + 2._dp*Tperp_)/3._dp - n_ TColl_ = TColl_ + T_*SQRT2*Kernel_i(ij_,ikx_,iky_,iz_) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ENDIF ! Multiply by ion-ion collision coefficient TColl_ = nu_i * TColl_ END SUBROUTINE DoughertyGK_i !******************************************************************************! !! compute the collision terms in a (Np x Nj x Nkx x Nky) matrix all at once !******************************************************************************! SUBROUTINE compute_TColl USE fields USE grid USE array USE basic USE prec_const USE time_integration USE model USE utility IMPLICIT NONE COMPLEX(dp), DIMENSION(1:total_np_e) :: local_sum_e, buffer_e, total_sum_e COMPLEX(dp), DIMENSION(ips_e:ipe_e) :: TColl_distr_e COMPLEX(dp), DIMENSION(1:total_np_i) :: local_sum_i, buffer_i, total_sum_i COMPLEX(dp), DIMENSION(ips_i:ipe_i) :: TColl_distr_i COMPLEX(dp) :: TColl INTEGER :: ikxs_C, ikxe_C, ikys_C, ikye_C ! Execution time start CALL cpu_time(t0_coll) IF (ABS(CO) .GE. 2) THEN !compute only if COSOlver matrices are used DO ikx = ikxs,ikxe DO iky = ikys,ikye DO iz = izs,ize + IF(KIN_E) THEN ! Electrons DO ij = 1,Jmaxe+1 ! Loop over all p to compute sub collision term DO ip = 1,total_np_e CALL apply_COSOlver_mat_e(ip,ij,ikx,iky,iz,TColl) local_sum_e(ip) = TColl ENDDO IF (num_procs_p .GT. 1) THEN ! Sum up all the sub collision terms on root 0 CALL MPI_REDUCE(local_sum_e, buffer_e, total_np_e, MPI_DOUBLE_COMPLEX, MPI_SUM, 1003, comm_p, ierr) ! distribute the sum over the process among p CALL MPI_SCATTERV(buffer_e, counts_np_e, displs_np_e, MPI_DOUBLE_COMPLEX,& TColl_distr_e, local_np_e, MPI_DOUBLE_COMPLEX,& 1003, comm_p, ierr) ELSE TColl_distr_e = local_sum_e ENDIF ! Write in output variable DO ip = ips_e,ipe_e TColl_e(ip,ij,ikx,iky,iz) = TColl_distr_e(ip) ENDDO ENDDO + ENDIF ! Ions DO ij = 1,Jmaxi+1 DO ip = 1,total_np_i CALL apply_COSOlver_mat_i(ip,ij,ikx,iky,iz,TColl) local_sum_i(ip) = TColl ENDDO IF (num_procs_p .GT. 1) THEN ! Reduce the local_sums to root = 0 CALL MPI_REDUCE(local_sum_i, buffer_i, total_np_i, MPI_DOUBLE_COMPLEX, MPI_SUM, 1004, comm_p, ierr) ! buffer contains the entire collision term along p, we scatter it between ! the other processes (use of scatterv since Pmax/Np is not an integer) CALL MPI_SCATTERV(buffer_i, counts_np_i, displs_np_i, MPI_DOUBLE_COMPLEX,& TColl_distr_i, local_np_i, MPI_DOUBLE_COMPLEX, & 1004, comm_p, ierr) ELSE TColl_distr_i = local_sum_i ENDIF ! Write in output variable DO ip = ips_i,ipe_i TColl_i(ip,ij,ikx,iky,iz) = TColl_distr_i(ip) ENDDO ENDDO ENDDO ENDDO ENDDO ENDIF ! Execution time end CALL cpu_time(t1_coll) tc_coll = tc_coll + (t1_coll - t0_coll) END SUBROUTINE compute_TColl !******************************************************************************! !!!!!!! Compute ion collision term !******************************************************************************! SUBROUTINE apply_COSOlver_mat_e(ip_,ij_,ikx_,iky_,iz_,TColl_) USE fields, ONLY: moments_e, moments_i USE grid USE array USE basic USE time_integration, ONLY: updatetlevel USE utility USE model, ONLY: CO, nu_e, nu_ee, CLOS IMPLICIT NONE INTEGER, INTENT(IN) :: ip_, ij_ ,ikx_, iky_, iz_ COMPLEX(dp), INTENT(OUT) :: TColl_ INTEGER :: ip2,ij2, p_int,j_int, p2_int,j2_int, ikx_C, iky_C p_int = parray_e_full(ip_); j_int = jarray_e_full(ij_); IF (CO .GT. 0) THEN ! GK operator (k-dependant) ikx_C = ikx_; iky_C = iky_ ELSEIF (CO .LT. 0) THEN ! DK operator (only one mat for every k) ikx_C = 1; iky_C = 1 ENDIF TColl_ = 0._dp ! Initialization of the local sum ! sum the electron-self and electron-ion test terms ploopee: DO ip2 = ips_e,ipe_e p2_int = parray_e(ip2) jloopee: DO ij2 = ijs_e,ije_e j2_int = jarray_e(ij2) IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxe))& TColl_ = TColl_ + moments_e(ip2,ij2,ikx_,iky_,iz_,updatetlevel) & *( nu_e * CeipjT(bare(p_int,j_int), bare(p2_int,j2_int),ikx_C, iky_C) & +nu_ee * Ceepj (bare(p_int,j_int), bare(p2_int,j2_int),ikx_C, iky_C)) ENDDO jloopee ENDDO ploopee ! sum the electron-ion field terms ploopei: DO ip2 = ips_i,ipe_i p2_int = parray_i(ip2) jloopei: DO ij2 = ijs_i,ije_i j2_int = jarray_i(ij2) IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxi))& TColl_ = TColl_ + moments_i(ip2,ij2,ikx_,iky_,iz_,updatetlevel) & *(nu_e * CeipjF(bare(p_int,j_int), bari(p2_int,j2_int),ikx_C, iky_C)) END DO jloopei ENDDO ploopei END SUBROUTINE apply_COSOlver_mat_e !******************************************************************************! !!!!!!! Compute ion collision term !******************************************************************************! SUBROUTINE apply_COSOlver_mat_i(ip_,ij_,ikx_,iky_,iz_,TColl_) USE fields, ONLY : moments_e, moments_i USE grid USE array USE basic USE time_integration, ONLY : updatetlevel USE utility - USE model, ONLY: CO, nu_i, nu_ie, CLOS + USE model, ONLY: CO, nu_i, nu_ie, CLOS, KIN_E IMPLICIT NONE INTEGER, INTENT(IN) :: ip_, ij_ ,ikx_, iky_, iz_ COMPLEX(dp), INTENT(OUT) :: TColl_ INTEGER :: ip2,ij2, p_int,j_int, p2_int,j2_int, ikx_C, iky_C p_int = parray_i_full(ip_); j_int = jarray_i_full(ij_); IF (CO .GT. 0) THEN ! GK operator (k-dependant) ikx_C = ikx_; iky_C = iky_ ELSEIF (CO .LT. 0) THEN ! DK operator (only one mat for every k) ikx_C = 1; iky_C = 1 ENDIF TColl_ = 0._dp ! Initialization ! sum the ion-self and ion-electron test terms ploopii: DO ip2 = ips_i,ipe_i p2_int = parray_i(ip2) jloopii: DO ij2 = ijs_i,ije_i j2_int = jarray_i(ij2) IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxi))& + ! Ion-ion collision TColl_ = TColl_ + moments_i(ip2,ij2,ikx_,iky_,iz_,updatetlevel) & - *( nu_ie * CiepjT(bari(p_int,j_int), bari(p2_int,j2_int), ikx_C, iky_C) & - +nu_i * Ciipj (bari(p_int,j_int), bari(p2_int,j2_int), ikx_C, iky_C)) + * nu_i * Ciipj (bari(p_int,j_int), bari(p2_int,j2_int), ikx_C, iky_C) + IF(KIN_E) & ! Ion-electron collision test + TColl_ = TColl_ + moments_i(ip2,ij2,ikx_,iky_,iz_,updatetlevel) & + * nu_ie * CiepjT(bari(p_int,j_int), bari(p2_int,j2_int), ikx_C, iky_C) ENDDO jloopii ENDDO ploopii + IF(KIN_E) THEN ! Ion-electron collision field ploopie: DO ip2 = ips_e,ipe_e ! sum the ion-electron field terms p2_int = parray_e(ip2) jloopie: DO ij2 = ijs_e,ije_e j2_int = jarray_e(ij2) IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxe))& TColl_ = TColl_ + moments_e(ip2,ij2,ikx_,iky_,iz_,updatetlevel) & *(nu_ie * CiepjF(bari(p_int,j_int), bare(p2_int,j2_int), ikx_C, iky_C)) ENDDO jloopie ENDDO ploopie + ENDIF END SUBROUTINE apply_COSOlver_mat_i !******************************************************************************! !!!!!!! Load the collision matrix coefficient table from COSOlver results !******************************************************************************! SUBROUTINE load_COSOlver_mat ! Load a sub matrix from iCa files (works for pmaxa,jmaxa<=P_full,J_full) use futils use initial_par USE grid USE array, ONLY: Ceepj, Ciipj, CeipjF, CeipjT, CiepjF, CiepjT USE basic USE time_integration, ONLY : updatetlevel USE utility USE model, ONLY: CO, NON_LIN, sigmae2_taue_o2, sigmai2_taui_o2 IMPLICIT NONE ! Indices for row and columns of the COSOlver matrix (4D compressed 2D matrices) INTEGER :: irow_sub, irow_full, icol_sub, icol_full INTEGER :: fid ! file indexation INTEGER :: ip_e, ij_e, il_e, ik_e, ikps_C, ikpe_C ! indices for electrons loops REAL(dp), DIMENSION(2) :: dims_e INTEGER :: pdime, jdime ! dimensions of the COSOlver matrices REAL(dp), DIMENSION(:,:), ALLOCATABLE :: Ceepj_full, CeipjT_full ! To load the entire matrix REAL(dp), DIMENSION(:,:), ALLOCATABLE :: CeipjF_full ! '' REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ceepj__kp, CeipjT_kp ! To store the coeff that will be used along kperp REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: CeipjF_kp ! '' INTEGER :: ip_i, ij_i, il_i, ik_i ! same for ions INTEGER, DIMENSION(2) :: dims_i INTEGER :: pdimi, jdimi ! dimensions of the COSOlver matrices REAL(dp), DIMENSION(:,:), ALLOCATABLE :: Ciipj_full, CiepjT_full ! . REAL(dp), DIMENSION(:,:), ALLOCATABLE :: CiepjF_full ! . REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ciipj__kp, CiepjT_kp ! . REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: CiepjF_kp ! . INTEGER :: NFLR REAL(dp), DIMENSION(:), ALLOCATABLE :: kp_grid_mat ! kperp grid of the matrices INTEGER :: ikp_next, ikp_prev, nkp_mat, ikp_mat REAL(dp) :: kp_max REAL(dp) :: kp_next, kp_prev, kperp_sim, kperp_mat, zerotoone, be_2, bi_2 CHARACTER(len=128) :: var_name, kperp_string, ikp_string LOGICAL :: CO_AA_ONLY = .false. ! Flag to remove ei ie collision !! Some terminal info IF (CO .EQ. 2) THEN IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK Sugama matrix ===' ELSEIF(CO .EQ. 3) THEN IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK pitch angle matrix ===' ELSEIF(CO .EQ. 4) THEN IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK Coulomb matrix ===' ELSEIF(CO .EQ. -2) THEN IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK Sugama matrix ===' ELSEIF(CO .EQ. -3) THEN IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK pitch angle matrix ===' ELSEIF(CO .EQ. -4) THEN IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK Coulomb matrix ===' ENDIF ! Opening the compiled cosolver matrices results if(my_id.EQ.0)write(*,*) mat_file CALL openf(mat_file,fid, 'r', 'D', mpicomm=comm_p); ! Get matrices dimensions (polynomials degrees and kperp grid) CALL getarr(fid, '/dims_e', dims_e) ! Get the electron polynomial degrees pdime = dims_e(1); jdime = dims_e(2); CALL getarr(fid, '/dims_i', dims_i) ! Get the ion polynomial degrees pdimi = dims_i(1); jdimi = dims_i(2); IF ( ((pdime .LT. pmaxe) .OR. (jdime .LT. jmaxe)) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Pe,Je Matrix too small !!' IF ( ((pdimi .LT. pmaxi) .OR. (jdimi .LT. jmaxi)) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Pi,Ji Matrix too small !!' CALL getsize(fid, '/coordkperp', nkp_mat) ! Get the dimension kperp grid of the matrices CALL allocate_array(kp_grid_mat, 1,nkp_mat) CALL getarr(fid, '/coordkperp', kp_grid_mat) ! check that we have enough kperps mat kp_max = SQRT(MAXVAL(kxarray)**2+MAXVAL(kyarray)**2) IF (NON_LIN) THEN IF ( (kp_grid_mat(nkp_mat) .LT. 2./3.*kp_max) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Matrix kperp grid too small !!' ELSE IF ( (kp_grid_mat(nkp_mat) .LT. kp_max) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Matrix kperp grid too small !!' ENDIF IF (CO .GT. 0) THEN ! GK operator (k-dependant) ikps_C = 1; ikpe_C = nkp_mat ELSEIF (CO .LT. 0) THEN ! DK operator (only one mat for all k) ikps_C = 1; ikpe_C = 1 ENDIF CALL allocate_array( Ceepj__kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C) CALL allocate_array( CeipjT_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C) CALL allocate_array( CeipjF_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C) CALL allocate_array( Ciipj__kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C) CALL allocate_array( CiepjT_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C) CALL allocate_array( CiepjF_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C) DO ikp = ikps_C,ikpe_C ! Loop over everz kperp values ! we put zeros if kp>2/3kpmax because thoses frequencies are filtered through AA IF( (kp_grid_mat(ikp) .GT. two_third_kpmax) .AND. NON_LIN) THEN CiepjT_kp(:,:,ikp) = 0._dp CiepjF_kp(:,:,ikp) = 0._dp CeipjT_kp(:,:,ikp) = 0._dp CeipjF_kp(:,:,ikp) = 0._dp Ceepj__kp(:,:,ikp) = 0._dp Ciipj__kp(:,:,ikp) = 0._dp ELSE ! Kperp value in string format IF (CO .GT. 0) THEN write(ikp_string,'(i5.5)') ikp-1 ELSE write(ikp_string,'(i5.5)') 0 ENDIF !!!!!!!!!!!! E-E matrices !!!!!!!!!!!! ! get the self electron colision matrix ! Allocate space for storing full collision matrix CALL allocate_array( Ceepj_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1)) ! Naming of the array to load (kperp dependant) WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Caapj/Ceepj' CALL getarr(fid, var_name, Ceepj_full) ! get array (moli format) ! Fill sub array with the usefull polynmial degrees only DO ip_e = 0,pmaxe ! Loop over rows DO ij_e = 0,jmaxe irow_sub = (jmaxe +1)*ip_e + ij_e +1 irow_full = (jdime +1)*ip_e + ij_e +1 DO il_e = 0,pmaxe ! Loop over columns DO ik_e = 0,jmaxe icol_sub = (jmaxe +1)*il_e + ik_e +1 icol_full = (jdime +1)*il_e + ik_e +1 Ceepj__kp (irow_sub,icol_sub,ikp) = Ceepj_full (irow_full,icol_full) ENDDO ENDDO ENDDO ENDDO DEALLOCATE(Ceepj_full) !!!!!!!!!!!!!!! I-I matrices !!!!!!!!!!!!!! ! get the self electron colision matrix CALL allocate_array( Ciipj_full, 1,(pdimi+1)*(jdimi+1), 1,(pdimi+1)*(jdimi+1)) WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Caapj/Ciipj' CALL getarr(fid, var_name, Ciipj_full) ! get array (moli format) ! Fill sub array with only usefull polynmials degree DO ip_i = 0,Pmaxi ! Loop over rows DO ij_i = 0,Jmaxi irow_sub = (Jmaxi +1)*ip_i + ij_i +1 irow_full = (jdimi +1)*ip_i + ij_i +1 DO il_i = 0,Pmaxi ! Loop over columns DO ik_i = 0,Jmaxi icol_sub = (Jmaxi +1)*il_i + ik_i +1 icol_full = (jdimi +1)*il_i + ik_i +1 Ciipj__kp (irow_sub,icol_sub,ikp) = Ciipj_full (irow_full,icol_full) ENDDO ENDDO ENDDO ENDDO DEALLOCATE(Ciipj_full) IF(abs(CO) .NE. 3) THEN ! Pitch angle is only applied on like-species !!!!!!!!!!!!!!! E-I matrices !!!!!!!!!!!!!! ! Get test and field e-i collision matrices CALL allocate_array( CeipjT_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1)) CALL allocate_array( CeipjF_full, 1,(pdime+1)*(jdime+1), 1,(pdimi+1)*(jdimi+1)) WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Ceipj/CeipjT' CALL getarr(fid, var_name, CeipjT_full) WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Ceipj/CeipjF' CALL getarr(fid, var_name, CeipjF_full) ! Fill sub array with only usefull polynmials degree DO ip_e = 0,pmaxe ! Loop over rows DO ij_e = 0,jmaxe irow_sub = (jmaxe +1)*ip_e + ij_e +1 irow_full = (jdime +1)*ip_e + ij_e +1 DO il_e = 0,pmaxe ! Loop over columns DO ik_e = 0,jmaxe icol_sub = (jmaxe +1)*il_e + ik_e +1 icol_full = (jdime +1)*il_e + ik_e +1 CeipjT_kp(irow_sub,icol_sub,ikp) = CeipjT_full(irow_full,icol_full) ENDDO ENDDO DO il_i = 0,pmaxi ! Loop over columns DO ik_i = 0,jmaxi icol_sub = (Jmaxi +1)*il_i + ik_i +1 icol_full = (jdimi +1)*il_i + ik_i +1 CeipjF_kp(irow_sub,icol_sub,ikp) = CeipjF_full(irow_full,icol_full) ENDDO ENDDO ENDDO ENDDO DEALLOCATE(CeipjF_full) DEALLOCATE(CeipjT_full) !!!!!!!!!!!!!!! I-E matrices !!!!!!!!!!!!!! ! get the Test and Back field electron ion collision matrix CALL allocate_array( CiepjT_full, 1,(pdimi+1)*(jdimi+1), 1,(pdimi+1)*(jdimi+1)) CALL allocate_array( CiepjF_full, 1,(pdimi+1)*(jdimi+1), 1,(pdime+1)*(jdime+1)) WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Ciepj/CiepjT' CALL getarr(fid, var_name, CiepjT_full) WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Ciepj/CiepjF' CALL getarr(fid, var_name, CiepjF_full) ! Fill sub array with only usefull polynmials degree DO ip_i = 0,Pmaxi ! Loop over rows DO ij_i = 0,Jmaxi irow_sub = (Jmaxi +1)*ip_i + ij_i +1 irow_full = (jdimi +1)*ip_i + ij_i +1 DO il_i = 0,Pmaxi ! Loop over columns DO ik_i = 0,Jmaxi icol_sub = (Jmaxi +1)*il_i + ik_i +1 icol_full = (jdimi +1)*il_i + ik_i +1 CiepjT_kp(irow_sub,icol_sub,ikp) = CiepjT_full(irow_full,icol_full) ENDDO ENDDO DO il_e = 0,pmaxe ! Loop over columns DO ik_e = 0,jmaxe icol_sub = (jmaxe +1)*il_e + ik_e +1 icol_full = (jdime +1)*il_e + ik_e +1 CiepjF_kp(irow_sub,icol_sub,ikp) = CiepjF_full(irow_full,icol_full) ENDDO ENDDO ENDDO ENDDO DEALLOCATE(CiepjF_full) DEALLOCATE(CiepjT_full) ELSE CeipjT_kp = 0._dp; CeipjF_kp = 0._dp; CiepjT_kp = 0._dp; CiepjF_kp = 0._dp; ENDIF ENDIF ENDDO CALL closef(fid) IF (CO .GT. 0) THEN ! Interpolation of the kperp matrix values on kx ky grid IF (my_id .EQ. 0 ) WRITE(*,*) '...Interpolation from matrices kperp to simulation kx,ky...' DO ikx = ikxs,ikxe DO iky = ikys,ikye kperp_sim = SQRT(kxarray(ikx)**2+kyarray(iky)**2) ! current simulation kperp ! Find the interval in kp grid mat where kperp_sim is contained ! Loop over the whole kp mat grid to find the smallest kperp that is ! larger than the current kperp_sim (brute force...) DO ikp=1,nkp_mat ikp_mat = ikp ! the first indice of the interval (k0) kperp_mat = kp_grid_mat(ikp) IF(kperp_mat .GT. kperp_sim) EXIT ! a matrix with kperp2 > current kx2 + ky2 has been found ENDDO ! Interpolation ! interval boundaries ikp_next = ikp_mat !index of k1 (larger than kperp_sim thanks to previous loop) ikp_prev = ikp_mat - 1 !index of k0 (smaller neighbour to interpolate inbetween) ! write(*,*) kp_grid_mat(ikp_prev), '<', kperp_sim, '<', kp_grid_mat(ikp_next) if ( (kp_grid_mat(ikp_prev) .GT. kperp_sim) .OR. (kp_grid_mat(ikp_next) .LT. kperp_sim) )& write(*,*) 'Warning, linear interp of collision matrix failed!!' ! 0->1 variable for linear interp, i.e. zero2one = (k-k0)/(k1-k0) zerotoone = (kperp_sim - kp_grid_mat(ikp_prev))/(kp_grid_mat(ikp_next) - kp_grid_mat(ikp_prev)) ! Linear interpolation between previous and next kperp matrix values Ceepj (:,:,ikx,iky) = (Ceepj__kp(:,:,ikp_next) - Ceepj__kp(:,:,ikp_prev))*zerotoone + Ceepj__kp(:,:,ikp_prev) CeipjT(:,:,ikx,iky) = (CeipjT_kp(:,:,ikp_next) - CeipjT_kp(:,:,ikp_prev))*zerotoone + CeipjT_kp(:,:,ikp_prev) CeipjF(:,:,ikx,iky) = (CeipjF_kp(:,:,ikp_next) - CeipjF_kp(:,:,ikp_prev))*zerotoone + CeipjF_kp(:,:,ikp_prev) Ciipj (:,:,ikx,iky) = (Ciipj__kp(:,:,ikp_next) - Ciipj__kp(:,:,ikp_prev))*zerotoone + Ciipj__kp(:,:,ikp_prev) CiepjT(:,:,ikx,iky) = (CiepjT_kp(:,:,ikp_next) - CiepjT_kp(:,:,ikp_prev))*zerotoone + CiepjT_kp(:,:,ikp_prev) CiepjF(:,:,ikx,iky) = (CiepjF_kp(:,:,ikp_next) - CiepjF_kp(:,:,ikp_prev))*zerotoone + CiepjF_kp(:,:,ikp_prev) ENDDO ENDDO ELSE ! DK -> No kperp dep, copy simply to final collision matrices Ceepj (:,:,1,1) = Ceepj__kp (:,:,1) CeipjT(:,:,1,1) = CeipjT_kp(:,:,1) CeipjF(:,:,1,1) = CeipjF_kp(:,:,1) Ciipj (:,:,1,1) = Ciipj__kp (:,:,1) CiepjT(:,:,1,1) = CiepjT_kp(:,:,1) CiepjF(:,:,1,1) = CiepjF_kp(:,:,1) ENDIF ! Deallocate auxiliary variables DEALLOCATE (Ceepj__kp); DEALLOCATE (CeipjT_kp); DEALLOCATE (CeipjF_kp) DEALLOCATE (Ciipj__kp); DEALLOCATE (CiepjT_kp); DEALLOCATE (CiepjF_kp) IF( CO_AA_ONLY ) THEN CeipjF = 0._dp; CeipjT = 0._dp; CiepjF = 0._dp; CiepjT = 0._dp; ENDIF IF (my_id .EQ. 0) WRITE(*,*) '============DONE===========' END SUBROUTINE load_COSOlver_mat !******************************************************************************! end module collision diff --git a/src/compute_Sapj.F90 b/src/compute_Sapj.F90 index 967e103..bfc8349 100644 --- a/src/compute_Sapj.F90 +++ b/src/compute_Sapj.F90 @@ -1,224 +1,227 @@ SUBROUTINE compute_Sapj ! This routine is meant to compute the non linear term for each specie and degree !! In real space Sapj ~ b*(grad(phi) x grad(g)) which in moments in fourier becomes !! Sapj = Sum_n (ikx Kn phi)#(iky Sum_s d_njs Naps) - (iky Kn phi)#(ikx Sum_s d_njs Naps) !! where # denotes the convolution. USE array, ONLY : dnjs, Sepj, Sipj, kernel_i, kernel_e USE basic USE fourier USE fields!, ONLY : phi, moments_e, moments_i USE grid USE model USE prec_const USE time_integration!, ONLY : updatetlevel IMPLICIT NONE INCLUDE 'fftw3-mpi.f03' COMPLEX(dp), DIMENSION(ikxs:ikxe,ikys:ikye) :: Fx_cmpx, Gy_cmpx COMPLEX(dp), DIMENSION(ikxs:ikxe,ikys:ikye) :: Fy_cmpx, Gx_cmpx, F_conv_G REAL(dp), DIMENSION(ixs:ixe,iys:iye) :: fr_real, gz_real REAL(dp), DIMENSION(ixs:ixe,iys:iye) :: fz_real, gr_real, f_times_g INTEGER :: in, is, p_int, j_int INTEGER :: nmax, smax ! Upper bound of the sums REAL(dp):: kx, ky, kerneln ! Execution time start CALL cpu_time(t0_Sapj) -zloop: DO iz = izs,ize !!!!!!!!!!!!!!!!!!!! ELECTRON non linear term computation (Sepj)!!!!!!!!!! + IF(KIN_E) THEN + zloope: DO iz = izs,ize ploope: DO ip = ips_e,ipe_e ! Loop over Hermite moments p_int = parray_e(ip) jloope: DO ij = ijs_e, ije_e ! Loop over Laguerre moments j_int=jarray_e(ij) ! GF closure check (spare computations too) GF_CLOSURE_e: IF ((CLOS.EQ.1) .AND. (p_int+2*j_int .GT. dmaxe)) THEN ! Do nothing DO ikx = ikxs, ikxe DO iky = ikys, ikye Sepj(ip,ij,ikx,iky,iz) = 0._dp ENDDO ENDDO ELSE real_data_c = 0._dp ! initialize sum over real nonlinear term ! Set non linear sum truncation IF (NL_CLOS .EQ. -2) THEN nmax = Jmaxe ELSEIF (NL_CLOS .EQ. -1) THEN nmax = Jmaxe-(ij-1) ELSE nmax = NL_CLOS ENDIF nloope: DO in = 1,nmax+1 ! Loop over laguerre for the sum kxloope: DO ikx = ikxs,ikxe ! Loop over kx kyloope: DO iky = ikys,ikye ! Loop over ky kx = kxarray(ikx) ky = kyarray(iky) kerneln = kernel_e(in, ikx, iky, iz) ! First convolution terms Fx_cmpx(ikx,iky) = imagu*kx* phi(ikx,iky,iz) * kerneln Fy_cmpx(ikx,iky) = imagu*ky* phi(ikx,iky,iz) * kerneln ! Second convolution terms Gy_cmpx(ikx,iky) = 0._dp ! initialization of the sum Gx_cmpx(ikx,iky) = 0._dp ! initialization of the sum smax = MIN( (in-1)+(ij-1), jmaxe ); DO is = 1, smax+1 ! sum truncation on number of moments Gy_cmpx(ikx,iky) = Gy_cmpx(ikx,iky) + & dnjs(in,ij,is) * moments_e(ip,is,ikx,iky,iz,updatetlevel) Gx_cmpx(ikx,iky) = Gx_cmpx(ikx,iky) + & dnjs(in,ij,is) * moments_e(ip,is,ikx,iky,iz,updatetlevel) ENDDO Gy_cmpx(ikx,iky) = imagu*ky*Gy_cmpx(ikx,iky) Gx_cmpx(ikx,iky) = imagu*kx*Gx_cmpx(ikx,iky) ENDDO kyloope ENDDO kxloope ! First term drphi x dzf DO ikx = ikxs, ikxe DO iky = ikys, ikye cmpx_data_f(iky,ikx-local_nkx_offset) = Fx_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) !Anti aliasing filter cmpx_data_g(iky,ikx-local_nkx_offset) = Gy_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) !Anti aliasing filter ENDDO ENDDO call fftw_mpi_execute_dft_c2r(planb, cmpx_data_f, real_data_f) call fftw_mpi_execute_dft_c2r(planb, cmpx_data_g, real_data_g) real_data_c = real_data_c + real_data_f/Ny/Nx * real_data_g/Ny/Nx ! Second term -dzphi x drf DO ikx = ikxs, ikxe DO iky = ikys, ikye cmpx_data_f(iky,ikx-local_nkx_offset) = Fy_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) !Anti aliasing filter cmpx_data_g(iky,ikx-local_nkx_offset) = Gx_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) !Anti aliasing filter ENDDO ENDDO call fftw_mpi_execute_dft_c2r(planb, cmpx_data_f, real_data_f) call fftw_mpi_execute_dft_c2r(planb, cmpx_data_g, real_data_g) real_data_c = real_data_c - real_data_f/Ny/Nx * real_data_g/Ny/Nx ENDDO nloope ! Put the real nonlinear product into k-space call fftw_mpi_execute_dft_r2c(planf, real_data_c, cmpx_data_c) ! Retrieve convolution in input format DO ikx = ikxs, ikxe DO iky = ikys, ikye Sepj(ip,ij,ikx,iky,iz) = cmpx_data_c(iky,ikx-local_nkx_offset)*AA_x(ikx)*AA_y(iky) !Anti aliasing filter ENDDO ENDDO ENDIF GF_CLOSURE_e ENDDO jloope ENDDO ploope +ENDDO zloope +ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!! ION non linear term computation (Sipj)!!!!!!!!!! +zloopi: DO iz = izs,ize ploopi: DO ip = ips_i,ipe_i ! Loop over Hermite moments ! we check if poly degree is even (eq to index is odd) to spare computation !EVEN_P_i: IF (.TRUE. .OR. (MODULO(ip,2) .EQ. 1) .OR. (.NOT. COMPUTE_ONLY_EVEN_P)) THEN jloopi: DO ij = ijs_i, ije_i ! Loop over Laguerre moments j_int=jarray_i(ij) ! GF closure check (spare computations too) GF_CLOSURE_i: IF ((CLOS.EQ.1) .AND. (p_int+2*j_int .GT. dmaxi)) THEN ! Do nothing DO ikx = ikxs, ikxe DO iky = ikys, ikye Sipj(ip,ij,ikx,iky,iz) = 0._dp ENDDO ENDDO ELSE real_data_c = 0._dp ! initialize sum over real nonlinear term ! Set non linear sum truncation IF (NL_CLOS .EQ. -2) THEN nmax = Jmaxi ELSEIF (NL_CLOS .EQ. -1) THEN nmax = Jmaxi-(ij-1) ELSE nmax = NL_CLOS ENDIF nloopi: DO in = 1,nmax+1 ! Loop over laguerre for the sum kxloopi: DO ikx = ikxs,ikxe ! Loop over kx kyloopi: DO iky = ikys,ikye ! Loop over ky kx = kxarray(ikx) ky = kyarray(iky) kerneln = kernel_i(in, ikx, iky, iz) ! First convolution terms Fx_cmpx(ikx,iky) = imagu*kx* phi(ikx,iky,iz) * kerneln Fy_cmpx(ikx,iky) = imagu*ky* phi(ikx,iky,iz) * kerneln ! Second convolution terms Gy_cmpx(ikx,iky) = 0._dp ! initialization of the sum Gx_cmpx(ikx,iky) = 0._dp ! initialization of the sum smax = MIN( (in-1)+(ij-1), jmaxi ); DO is = 1, smax+1 ! sum truncation on number of moments Gy_cmpx(ikx,iky) = Gy_cmpx(ikx,iky) + & dnjs(in,ij,is) * moments_i(ip,is,ikx,iky,iz,updatetlevel) Gx_cmpx(ikx,iky) = Gx_cmpx(ikx,iky) + & dnjs(in,ij,is) * moments_i(ip,is,ikx,iky,iz,updatetlevel) ENDDO Gy_cmpx(ikx,iky) = imagu*ky*Gy_cmpx(ikx,iky) Gx_cmpx(ikx,iky) = imagu*kx*Gx_cmpx(ikx,iky) ENDDO kyloopi ENDDO kxloopi ! First term drphi x dzf DO ikx = ikxs, ikxe DO iky = ikys, ikye cmpx_data_f(iky,ikx-local_nkx_offset) = Fx_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) cmpx_data_g(iky,ikx-local_nkx_offset) = Gy_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO call fftw_mpi_execute_dft_c2r(planb, cmpx_data_f, real_data_f) call fftw_mpi_execute_dft_c2r(planb, cmpx_data_g, real_data_g) real_data_c = real_data_c + real_data_f/Ny/Nx * real_data_g/Ny/Nx ! Second term -dzphi x drf DO ikx = ikxs, ikxe DO iky = ikys, ikye cmpx_data_f(iky,ikx-local_nkx_offset) = Fy_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) cmpx_data_g(iky,ikx-local_nkx_offset) = Gx_cmpx(ikx,iky)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO call fftw_mpi_execute_dft_c2r(planb, cmpx_data_f, real_data_f) call fftw_mpi_execute_dft_c2r(planb, cmpx_data_g, real_data_g) real_data_c = real_data_c - real_data_f/Ny/Nx * real_data_g/Ny/Nx ENDDO nloopi ! Put the real nonlinear product into k-space call fftw_mpi_execute_dft_r2c(planf, real_data_c, cmpx_data_c) ! Retrieve convolution in input format DO ikx = ikxs, ikxe DO iky = ikys, ikye Sipj(ip,ij,ikx,iky,iz) = cmpx_data_c(iky,ikx-local_nkx_offset)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO ENDIF GF_CLOSURE_i ENDDO jloopi ENDDO ploopi +ENDDO zloopi !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Execution time END CALL cpu_time(t1_Sapj) tc_Sapj = tc_Sapj + (t1_Sapj - t0_Sapj) - -ENDDO zloop END SUBROUTINE compute_Sapj diff --git a/src/diagnose.F90 b/src/diagnose.F90 index 4ab9b96..1ba38d8 100644 --- a/src/diagnose.F90 +++ b/src/diagnose.F90 @@ -1,538 +1,553 @@ SUBROUTINE diagnose(kstep) ! Diagnostics, writing simulation state to disk USE basic USE grid USE diagnostics_par USE futils, ONLY: creatf, creatg, creatd, closef, putarr, putfile, attach, openf, putarrnd USE model USE initial_par USE fields USE time_integration USE utility USE prec_const IMPLICIT NONE INCLUDE 'srcinfo.h' INTEGER, INTENT(in) :: kstep INTEGER, parameter :: BUFSIZE = 2 INTEGER :: rank = 0 INTEGER :: dims(1) = (/0/) INTEGER :: cp_counter = 0 CHARACTER(len=256) :: str, fname,test_ CALL cpu_time(t0_diag) ! Measuring time !_____________________________________________________________________________ ! 1. Initial diagnostics IF ((kstep .EQ. 0)) THEN ! Writing output filename WRITE(resfile,'(a,a1,i2.2,a3)') TRIM(resfile0),'_',jobnum,'.h5' ! 1.1 Initial run ! Main output file creation IF (write_doubleprecision) THEN CALL creatf(resfile, fidres, real_prec='d', mpicomm=comm0) ELSE CALL creatf(resfile, fidres, mpicomm=comm0) END IF IF (my_id .EQ. 0) WRITE(*,'(3x,a,a)') TRIM(resfile), ' created' ! Data group CALL creatg(fidres, "/data", "data") ! File group CALL creatg(fidres, "/files", "files") CALL attach(fidres, "/files", "jobnum", jobnum) ! Profiler time measurement CALL creatg(fidres, "/profiler", "performance analysis") CALL creatd(fidres, 0, dims, "/profiler/Tc_rhs", "cumulative rhs computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_adv_field", "cumulative adv. fields computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_clos", "cumulative closure computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_ghost", "cumulative communication time") CALL creatd(fidres, 0, dims, "/profiler/Tc_coll", "cumulative collision computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_poisson", "cumulative poisson computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_Sapj", "cumulative Sapj computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_checkfield", "cumulative checkfield computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_diag", "cumulative sym computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_step", "cumulative total step computation time") CALL creatd(fidres, 0, dims, "/profiler/time", "current simulation time") ! Grid info CALL creatg(fidres, "/data/grid", "Grid data") CALL putarr(fidres, "/data/grid/coordkx", kxarray_full, "kx*rho_s0", ionode=0) CALL putarr(fidres, "/data/grid/coordky", kyarray_full, "ky*rho_s0", ionode=0) CALL putarr(fidres, "/data/grid/coordz", zarray_full, "z/R", ionode=0) CALL putarr(fidres, "/data/grid/coordp_e" , parray_e_full, "p_e", ionode=0) CALL putarr(fidres, "/data/grid/coordj_e" , jarray_e_full, "j_e", ionode=0) CALL putarr(fidres, "/data/grid/coordp_i" , parray_i_full, "p_i", ionode=0) CALL putarr(fidres, "/data/grid/coordj_i" , jarray_i_full, "j_i", ionode=0) ! var0d group (gyro transport) IF (nsave_0d .GT. 0) THEN CALL creatg(fidres, "/data/var0d", "0d profiles") CALL creatd(fidres, rank, dims, "/data/var0d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var0d/cstep", "iteration number") IF (write_gamma) THEN CALL creatd(fidres, rank, dims, "/data/var0d/gflux_ri", "Radial gyro ion transport") CALL creatd(fidres, rank, dims, "/data/var0d/pflux_ri", "Radial part ion transport") ENDIF IF (write_hf) THEN CALL creatd(fidres, rank, dims, "/data/var0d/hflux_x", "Radial part ion heat flux") ENDIF IF (cstep==0) THEN iframe0d=0 ENDIF CALL attach(fidres,"/data/var0d/" , "frames", iframe0d) END IF ! var2d group (??) IF (nsave_2d .GT. 0) THEN CALL creatg(fidres, "/data/var2d", "2d profiles") CALL creatd(fidres, rank, dims, "/data/var2d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var2d/cstep", "iteration number") IF (cstep==0) THEN iframe2d=0 ENDIF CALL attach(fidres,"/data/var2d/" , "frames", iframe2d) END IF ! var3d group (electro. pot., Ni00 moment) IF (nsave_3d .GT. 0) THEN CALL creatg(fidres, "/data/var3d", "3d profiles") CALL creatd(fidres, rank, dims, "/data/var3d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var3d/cstep", "iteration number") IF (write_phi) CALL creatg(fidres, "/data/var3d/phi", "phi") IF (write_Na00) THEN + IF(KIN_E)& CALL creatg(fidres, "/data/var3d/Ne00", "Ne00") CALL creatg(fidres, "/data/var3d/Ni00", "Ni00") ENDIF IF (write_dens) THEN + IF(KIN_E)& CALL creatg(fidres, "/data/var3d/dens_e", "dens_e") CALL creatg(fidres, "/data/var3d/dens_i", "dens_i") ENDIF IF (write_temp) THEN + IF(KIN_E)& CALL creatg(fidres, "/data/var3d/temp_e", "temp_e") CALL creatg(fidres, "/data/var3d/temp_i", "temp_i") ENDIF IF (cstep==0) THEN iframe3d=0 ENDIF CALL attach(fidres,"/data/var3d/" , "frames", iframe3d) END IF ! var5d group (moments) IF (nsave_5d .GT. 0) THEN CALL creatg(fidres, "/data/var5d", "5d profiles") CALL creatd(fidres, rank, dims, "/data/var5d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var5d/cstep", "iteration number") IF (write_Napj) THEN + IF(KIN_E)& CALL creatg(fidres, "/data/var5d/moments_e", "moments_e") CALL creatg(fidres, "/data/var5d/moments_i", "moments_i") ENDIF IF (write_Sapj) THEN + IF(KIN_E)& CALL creatg(fidres, "/data/var5d/moments_e", "Sipj") CALL creatg(fidres, "/data/var5d/moments_i", "Sepj") ENDIF IF (cstep==0) THEN iframe5d=0 END IF CALL attach(fidres,"/data/var5d/" , "frames", iframe5d) END IF ! Add input namelist variables as attributes of /data/input, defined in srcinfo.h IF (my_id .EQ. 0) WRITE(*,*) 'VERSION=', VERSION IF (my_id .EQ. 0) WRITE(*,*) 'BRANCH=', BRANCH IF (my_id .EQ. 0) WRITE(*,*) 'AUTHOR=', AUTHOR IF (my_id .EQ. 0) WRITE(*,*) 'HOST=', HOST WRITE(str,'(a,i2.2)') "/data/input" CALL creatd(fidres, rank,dims,TRIM(str),'Input parameters') CALL attach(fidres, TRIM(str), "version", VERSION) !defined in srcinfo.h CALL attach(fidres, TRIM(str), "branch", BRANCH) !defined in srcinfo.h CALL attach(fidres, TRIM(str), "author", AUTHOR) !defined in srcinfo.h CALL attach(fidres, TRIM(str), "execdate", EXECDATE) !defined in srcinfo.h CALL attach(fidres, TRIM(str), "host", HOST) !defined in srcinfo.h CALL attach(fidres, TRIM(str), "start_time", time) CALL attach(fidres, TRIM(str), "start_cstep", cstep-1) CALL attach(fidres, TRIM(str), "start_iframe0d", iframe0d) CALL attach(fidres, TRIM(str), "start_iframe2d", iframe2d) CALL attach(fidres, TRIM(str), "start_iframe3d", iframe3d) CALL attach(fidres, TRIM(str), "start_iframe5d", iframe5d) CALL attach(fidres, TRIM(str), "dt", dt) CALL attach(fidres, TRIM(str), "tmax", tmax) CALL attach(fidres, TRIM(str), "nrun", nrun) CALL attach(fidres, TRIM(str), "cpu_time", -1) CALL attach(fidres, TRIM(str), "Nproc", num_procs) CALL attach(fidres, TRIM(str), "Np_p" , num_procs_p) CALL attach(fidres, TRIM(str), "Np_kx",num_procs_kx) CALL attach(fidres, TRIM(str), "write_gamma", write_gamma) CALL attach(fidres, TRIM(str), "write_hf", write_hf) CALL attach(fidres, TRIM(str), "write_phi", write_phi) CALL attach(fidres, TRIM(str), "write_Na00", write_Na00) CALL attach(fidres, TRIM(str), "write_Napj", write_Napj) CALL attach(fidres, TRIM(str), "write_Sapj", write_Sapj) CALL attach(fidres, TRIM(str), "write_dens", write_dens) CALL attach(fidres, TRIM(str), "write_temp", write_temp) CALL grid_outputinputs(fidres, str) CALL diag_par_outputinputs(fidres, str) CALL model_outputinputs(fidres, str) CALL initial_outputinputs(fidres, str) CALL time_integration_outputinputs(fidres, str) ! Save STDIN (input file) of this run IF(jobnum .LE. 99) THEN WRITE(str,'(a,i2.2)') "/files/STDIN.",jobnum ELSE WRITE(str,'(a,i3.2)') "/files/STDIN.",jobnum END IF INQUIRE(unit=lu_in, name=fname) CLOSE(lu_in) CALL putfile(fidres, TRIM(str), TRIM(fname),ionode=0) ELSEIF((kstep .EQ. 0)) THEN IF(jobnum .LE. 99) THEN WRITE(resfile,'(a,a1,i2.2,a3)') TRIM(resfile0),'_',jobnum,'.h5' ELSE WRITE(resfile,'(a,a1,i3.2,a3)') TRIM(resfile0),'_',jobnum,'.h5' END IF CALL openf(resfile,fidres, 'D'); ENDIF !_____________________________________________________________________________ ! 2. Periodic diagnostics ! IF (kstep .GE. 0) THEN ! Terminal info IF (MOD(cstep, INT(1.0/dt)) == 0 .AND. (my_id .EQ. 0)) THEN WRITE(*,"(F6.0,A,F6.0)") time,"/",tmax ENDIF ! 2.1 0d history arrays IF (nsave_0d .GT. 0) THEN IF ( MOD(cstep, nsave_0d) == 0 ) THEN CALL diagnose_0d END IF END IF ! 2.2 1d profiles ! empty in our case ! 2.3 2d profiles ! empty in our case ! 2.3 2d profiles IF (nsave_3d .GT. 0) THEN IF (MOD(cstep, nsave_3d) == 0) THEN CALL diagnose_3d END IF END IF ! 2.4 3d profiles IF (nsave_5d .GT. 0 .AND. cstep .GT. 0) THEN IF (MOD(cstep, nsave_5d) == 0) THEN CALL diagnose_5d END IF END IF !_____________________________________________________________________________ ! 3. Final diagnostics ELSEIF (kstep .EQ. -1) THEN CALL cpu_time(finish) CALL attach(fidres, "/data/input","cpu_time",finish-start) ! make a checkpoint at last timestep if not crashed IF(.NOT. crashed) THEN IF(my_id .EQ. 0) write(*,*) 'Saving last state' CALL diagnose_5d ENDIF ! Display computational time cost IF (my_id .EQ. 0) CALL display_h_min_s(finish-start) ! Close all diagnostic files CALL closef(fidres) END IF CALL cpu_time(t1_diag); tc_diag = tc_diag + (t1_diag - t0_diag) END SUBROUTINE diagnose SUBROUTINE diagnose_0d USE basic USE futils, ONLY: append, attach, getatt USE diagnostics_par USE prec_const USE processing + USE model, ONLY: KIN_E IMPLICIT NONE ! Time measurement data CALL append(fidres, "/profiler/Tc_rhs", tc_rhs,ionode=0) CALL append(fidres, "/profiler/Tc_adv_field", tc_adv_field,ionode=0) CALL append(fidres, "/profiler/Tc_clos", tc_clos,ionode=0) CALL append(fidres, "/profiler/Tc_ghost", tc_ghost,ionode=0) CALL append(fidres, "/profiler/Tc_coll", tc_coll,ionode=0) CALL append(fidres, "/profiler/Tc_poisson", tc_poisson,ionode=0) CALL append(fidres, "/profiler/Tc_Sapj", tc_Sapj,ionode=0) CALL append(fidres, "/profiler/Tc_checkfield",tc_checkfield,ionode=0) CALL append(fidres, "/profiler/Tc_diag", tc_diag,ionode=0) CALL append(fidres, "/profiler/Tc_step", tc_step,ionode=0) CALL append(fidres, "/profiler/time", time,ionode=0) ! Processing data CALL append(fidres, "/data/var0d/time", time,ionode=0) CALL append(fidres, "/data/var0d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var0d/", "frames",iframe2d) iframe0d=iframe0d+1 CALL attach(fidres,"/data/var0d/" , "frames", iframe0d) ! Ion transport data IF (write_gamma) THEN CALL compute_radial_ion_transport CALL append(fidres, "/data/var0d/gflux_ri",gflux_ri,ionode=0) CALL append(fidres, "/data/var0d/pflux_ri",pflux_ri,ionode=0) ENDIF IF (write_hf) THEN CALL compute_radial_heatflux CALL append(fidres, "/data/var0d/hflux_x",hflux_x,ionode=0) ENDIF END SUBROUTINE diagnose_0d SUBROUTINE diagnose_2d USE basic USE futils, ONLY: append, getatt, attach, putarrnd USE fields USE array, ONLY: Ne00, Ni00, dens_e, dens_i, temp_e, temp_i USE grid, ONLY: ikxs,ikxe, ikys,ikye, Nkx, Nky, local_nkx, ikx, iky, ips_e, ips_i USE time_integration USE diagnostics_par USE prec_const USE processing + USE model, ONLY: KIN_E IMPLICIT NONE COMPLEX(dp) :: buffer(ikxs:ikxe,ikys:ikye) INTEGER :: i_, root, world_rank, world_size CALL append(fidres, "/data/var2d/time", time,ionode=0) CALL append(fidres, "/data/var2d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var2d/", "frames",iframe2d) iframe2d=iframe2d+1 CALL attach(fidres,"/data/var2d/" , "frames", iframe2d) CONTAINS SUBROUTINE write_field2d(field, text) USE futils, ONLY: attach, putarr USE grid, ONLY: ikxs,ikxe, ikys,ikye, Nkx, Nky, local_nkx USE prec_const USE basic, ONLY : comm_kx, num_procs_p, rank_p IMPLICIT NONE COMPLEX(dp), DIMENSION(ikxs:ikxe, ikys:ikye), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text COMPLEX(dp) :: buffer_dist(ikxs:ikxe,ikys:ikye) COMPLEX(dp) :: buffer_full(1:Nkx,1:Nky) INTEGER :: scount, rcount CHARACTER(LEN=50) :: dset_name scount = (ikxe-ikxs+1) * (ikye-ikys+1) rcount = scount WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var2d", TRIM(text), iframe2d IF (num_procs .EQ. 1) THEN ! no data distribution CALL putarr(fidres, dset_name, field(ikxs:ikxe, ikys:ikye), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ikxs:ikxe, ikys:ikye), (/1, 1/)) ENDIF CALL attach(fidres, dset_name, "time", time) END SUBROUTINE write_field2d END SUBROUTINE diagnose_2d SUBROUTINE diagnose_3d USE basic USE futils, ONLY: append, getatt, attach, putarrnd USE fields USE array, ONLY: Ne00, Ni00, dens_e, dens_i, temp_e, temp_i USE grid, ONLY: ikxs,ikxe, ikys,ikye, Nkx, Nky, local_nkx, ikx, iky, ips_e, ips_i USE time_integration USE diagnostics_par USE prec_const USE processing + USE model, ONLY: KIN_E IMPLICIT NONE INTEGER :: i_, root, world_rank, world_size CALL append(fidres, "/data/var3d/time", time,ionode=0) CALL append(fidres, "/data/var3d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var3d/", "frames",iframe3d) iframe3d=iframe3d+1 CALL attach(fidres,"/data/var3d/" , "frames", iframe3d) IF (write_phi) CALL write_field3d(phi (:,:,:), 'phi') IF (write_Na00) THEN - IF ( (ips_e .EQ. 1) .AND. (ips_i .EQ. 1) ) THEN + IF(KIN_E)THEN + IF (ips_e .EQ. 1) THEN Ne00(ikxs:ikxe,ikys:ikye,izs:ize) = moments_e(ips_e,1,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) - Ni00(ikxs:ikxe,ikys:ikye,izs:ize) = moments_i(ips_e,1,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) ENDIF - CALL manual_3D_bcast(Ne00(ikxs:ikxe,ikys:ikye,izs:ize)) CALL write_field3d(Ne00(ikxs:ikxe,ikys:ikye,izs:ize), 'Ne00') - + ENDIF + IF (ips_i .EQ. 1) THEN + Ni00(ikxs:ikxe,ikys:ikye,izs:ize) = moments_i(ips_e,1,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) + ENDIF CALL manual_3D_bcast(Ni00(ikxs:ikxe,ikys:ikye,izs:ize)) CALL write_field3d(Ni00(ikxs:ikxe,ikys:ikye,izs:ize), 'Ni00') ENDIF IF (write_dens) THEN CALL compute_density + IF(KIN_E)& CALL write_field3d(dens_e(ikxs:ikxe,ikys:ikye,izs:ize), 'dens_e') CALL write_field3d(dens_i(ikxs:ikxe,ikys:ikye,izs:ize), 'dens_i') ENDIF IF (write_temp) THEN CALL compute_temperature + IF(KIN_E)& CALL write_field3d(temp_e(ikxs:ikxe,ikys:ikye,izs:ize), 'temp_e') CALL write_field3d(temp_i(ikxs:ikxe,ikys:ikye,izs:ize), 'temp_i') ENDIF CONTAINS SUBROUTINE write_field3d(field, text) USE futils, ONLY: attach, putarr USE grid, ONLY: ikxs,ikxe, ikys,ikye, Nkx, Nky, local_nkx USE prec_const USE basic, ONLY : comm_kx, num_procs_p, rank_p IMPLICIT NONE COMPLEX(dp), DIMENSION(ikxs:ikxe, ikys:ikye, izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var3d", TRIM(text), iframe3d IF (num_procs .EQ. 1) THEN ! no data distribution CALL putarr(fidres, dset_name, field(ikxs:ikxe, ikys:ikye, izs:ize), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ikxs:ikxe, ikys:ikye, izs:ize), (/1, 1/)) ENDIF CALL attach(fidres, dset_name, "time", time) END SUBROUTINE write_field3d END SUBROUTINE diagnose_3d SUBROUTINE diagnose_5d USE basic USE futils, ONLY: append, getatt, attach, putarrnd USE fields USE array!, ONLY: Sepj, Sipj USE grid, ONLY: ips_e,ipe_e, ips_i, ipe_i, & ijs_e,ije_e, ijs_i, ije_i USE time_integration USE diagnostics_par USE prec_const + USE model, ONLY: KIN_E IMPLICIT NONE CALL append(fidres, "/data/var5d/time", time,ionode=0) CALL append(fidres, "/data/var5d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var5d/", "frames",iframe5d) iframe5d=iframe5d+1 CALL attach(fidres,"/data/var5d/" , "frames", iframe5d) IF (write_Napj) THEN + IF(KIN_E)& CALL write_field5d_e(moments_e(ips_e:ipe_e,ijs_e:ije_e,:,:,:,updatetlevel), 'moments_e') CALL write_field5d_i(moments_i(ips_i:ipe_i,ijs_i:ije_i,:,:,:,updatetlevel), 'moments_i') ENDIF IF (write_Sapj) THEN + IF(KIN_E)& CALL write_field5d_e(Sepj(ips_e:ipe_e,ijs_e:ije_e,:,:,:), 'Sepj') CALL write_field5d_i(Sipj(ips_i:ipe_i,ijs_i:ije_i,:,:,:), 'Sipj') ENDIF CONTAINS SUBROUTINE write_field5d_e(field, text) USE futils, ONLY: attach, putarr, putarrnd USE grid, ONLY: ips_e,ipe_e, ijs_e,ije_e, ikxs,ikxe, ikys,ikye, izs,ize USE prec_const IMPLICIT NONE COMPLEX(dp), DIMENSION(ips_e:ipe_e,ijs_e:ije_e,ikxs:ikxe,ikys:ikye,izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var5d", TRIM(text), iframe5d IF (num_procs .EQ. 1) THEN CALL putarr(fidres, dset_name, field(ips_e:ipe_e,ijs_e:ije_e,ikxs:ikxe,ikys:ikye,izs:ize), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ips_e:ipe_e,ijs_e:ije_e,ikxs:ikxe,ikys:ikye,izs:ize), (/1,3/)) ENDIF CALL attach(fidres, dset_name, 'cstep', cstep) CALL attach(fidres, dset_name, 'time', time) CALL attach(fidres, dset_name, 'jobnum', jobnum) CALL attach(fidres, dset_name, 'dt', dt) CALL attach(fidres, dset_name, 'iframe2d', iframe2d) CALL attach(fidres, dset_name, 'iframe5d', iframe5d) END SUBROUTINE write_field5d_e SUBROUTINE write_field5d_i(field, text) USE futils, ONLY: attach, putarr, putarrnd USE grid, ONLY: ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize USE prec_const IMPLICIT NONE COMPLEX(dp), DIMENSION(ips_i:ipe_i,ijs_i:ije_i,ikxs:ikxe,ikys:ikye,izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var5d", TRIM(text), iframe5d IF (num_procs .EQ. 1) THEN CALL putarr(fidres, dset_name, field(ips_i:ipe_i,ijs_i:ije_i,ikxs:ikxe,ikys:ikye,izs:ize), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ips_i:ipe_i,ijs_i:ije_i,ikxs:ikxe,ikys:ikye,izs:ize), (/1,3/)) ENDIF CALL attach(fidres, dset_name, 'cstep', cstep) CALL attach(fidres, dset_name, 'time', time) CALL attach(fidres, dset_name, 'jobnum', jobnum) CALL attach(fidres, dset_name, 'dt', dt) CALL attach(fidres, dset_name, 'iframe2d', iframe2d) CALL attach(fidres, dset_name, 'iframe5d', iframe5d) END SUBROUTINE write_field5d_i END SUBROUTINE diagnose_5d diff --git a/src/geometry_mod.F90 b/src/geometry_mod.F90 index be73c0a..2ef6d63 100644 --- a/src/geometry_mod.F90 +++ b/src/geometry_mod.F90 @@ -1,131 +1,139 @@ module geometry ! computes geometrical quantities ! Adapted from B.J.Frei MOLIX code (2021) use prec_const use model use grid use array use fields use basic + use utility, ONLY: simpson_rule_z implicit none public + COMPLEX(dp), PROTECTED :: iInt_Jacobian contains subroutine eval_magnetic_geometry ! evalute metrix, elements, jacobian and gradient implicit none REAL(dp) :: kx,ky + COMPLEX(dp), DIMENSION(izs:ize) :: integrant ! IF( (Ny .EQ. 1) .AND. (Nz .EQ. 1)) THEN !1D perp linear run IF( my_id .eq. 0 ) WRITE(*,*) '1D perpendicular geometry' call eval_1D_geometry ELSE IF( my_id .eq. 0 ) WRITE(*,*) 's-alpha-B geometry' call eval_salphaB_geometry ENDIF ! ! Evaluate perpendicular wavenumber ! k_\perp^2 = g^{xx} k_x^2 + 2 g^{xy}k_x k_y + k_y^2 g^{yy} ! normalized to rhos_ DO iz = izs,ize DO iky = ikys, ikye ky = kyarray(iky) DO ikx = ikxs, ikxe kx = kxarray(ikx) kparray(ikx, iky, iz) = & SQRT( gxx(iz)*kx**2 + 2._dp*gxy(iz)*kx*ky + gyy(iz)*ky**2)/hatB(iz) ! there is a factor 1/B from the normalization; important to match GENE ENDDO ENDDO ENDDO + ! + ! Compute the inverse z integrated Jacobian (useful for flux averaging) + integrant = Jacobian ! Convert into complex array + CALL simpson_rule_z(integrant,iInt_Jacobian) + iInt_Jacobian = 1._dp/iInt_Jacobian ! reverse it END SUBROUTINE eval_magnetic_geometry ! !-------------------------------------------------------------------------------- ! subroutine eval_salphaB_geometry ! evaluate s-alpha geometry model implicit none REAL(dp) :: z, kx, ky zloop: DO iz = izs,ize z = zarray(iz) ! metric gxx(iz) = 1._dp gxy(iz) = shear*z gyy(iz) = 1._dp + (shear*z)**2 ! Relative strengh of radius hatR(iz) = 1._dp + eps*COS(z) ! Jacobian Jacobian(iz) = q0*hatR(iz) ! Relative strengh of modulus of B hatB(iz) = 1._dp / hatR(iz) ! Derivative of the magnetic field strenght gradxB(iz) = -COS(z) gradzB(iz) = eps * SIN(z) / hatR(iz) ! Curvature operator DO iky = ikys, ikye ky = kyarray(iky) DO ikx= ikxs, ikxe kx = kxarray(ikx) Ckxky(ikx, iky, iz) = (-SIN(z)*kx - (COS(z) + shear* z* SIN(z))*ky) * hatB(iz) ! .. multiply by hatB to cancel the 1/ hatB factor in moments_eqs_rhs.f90 routine ENDDO ENDDO ! coefficient in the front of parallel derivative gradz_coeff(iz) = 1._dp / Jacobian(iz) / hatB(iz) ENDDO zloop END SUBROUTINE eval_salphaB_geometry ! !-------------------------------------------------------------------------------- ! subroutine eval_1D_geometry ! evaluate 1D perp geometry model implicit none REAL(dp) :: z, kx, ky zloop: DO iz = izs,ize z = zarray(iz) ! metric gxx(iz) = 1._dp gxy(iz) = 0._dp gyy(iz) = 1._dp ! Relative strengh of radius hatR(iz) = 1._dp ! Jacobian Jacobian(iz) = 1._dp ! Relative strengh of modulus of B hatB(iz) = 1._dp ! Curvature operator DO iky = ikys, ikye ky = kyarray(iky) DO ikx= ikxs, ikxe kx = kxarray(ikx) Ckxky(ikx, iky, iz) = -kx ! .. multiply by hatB to cancel the 1/ hatB factor in moments_eqs_rhs.f90 routine ENDDO ENDDO ! coefficient in the front of parallel derivative gradz_coeff(iz) = 1._dp ENDDO zloop END SUBROUTINE eval_1D_geometry ! !-------------------------------------------------------------------------------- ! end module geometry diff --git a/src/ghosts_mod.F90 b/src/ghosts_mod.F90 index c3a4e82..fa0757f 100644 --- a/src/ghosts_mod.F90 +++ b/src/ghosts_mod.F90 @@ -1,97 +1,98 @@ module ghosts USE basic USE fields, ONLY : moments_e, moments_i USE grid USE time_integration +USE model, ONLY : KIN_E IMPLICIT NONE INTEGER :: status(MPI_STATUS_SIZE), source, dest, count, ipg PUBLIC :: update_ghosts CONTAINS SUBROUTINE update_ghosts CALL cpu_time(t0_ghost) IF (num_procs_p .GT. 1) THEN ! Do it only if we share the p CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) - CALL update_ghosts_p_e + IF(KIN_E) CALL update_ghosts_p_e CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) CALL update_ghosts_p_i ENDIF CALL cpu_time(t1_ghost) tc_ghost = tc_ghost + (t1_ghost - t0_ghost) END SUBROUTINE update_ghosts !Communicate p+1, p+2 moments to left neighboor and p-1, p-2 moments to right one ! [a b|C D|e f] : proc n has moments a to f where a,b,e,f are ghosts ! !proc 0: [0 1 2 3 4|5 6] ! V V ^ ^ !proc 1: [3 4|5 6 7 8|9 10] ! V V ^ ^ !proc 2: [7 8|9 10 11 12|13 14] ! V V ^ ^ !proc 3: [11 12|13 14 15 16|17 18] ! ^ ^ !Closure by zero truncation : 0 0 SUBROUTINE update_ghosts_p_e IMPLICIT NONE count = (ijeg_e-ijsg_e+1)*(ikxe-ikxs+1)*(ikye-ikys+1)*(ize-izs+1) !!!!!!!!!!! Send ghost to right neighbour !!!!!!!!!!!!!!!!!!!!!! ! Send the last local moment to fill the -1 neighbour ghost CALL mpi_sendrecv(moments_e(ipe_e ,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 10, & ! Send to right moments_e(ips_e-1,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 10, & ! Recieve from left comm0, status, ierr) IF (deltape .EQ. 1) & ! If we have odd Hermite degrees we need a 2nd order stencil CALL mpi_sendrecv(moments_e(ipe_e-1,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 11, & ! Send to right moments_e(ips_e-2,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 11, & ! Recieve from left comm0, status, ierr) !!!!!!!!!!! Send ghost to left neighbour !!!!!!!!!!!!!!!!!!!!!! CALL mpi_sendrecv(moments_e(ips_e ,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 12, & ! Send to left moments_e(ipe_e+1,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 12, & ! Recieve from right comm0, status, ierr) IF (deltape .EQ. 1) & ! If we have odd Hermite degrees we need a 2nd order stencil CALL mpi_sendrecv(moments_e(ips_e+1,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 13, & ! Send to left moments_e(ipe_e+2,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 13, & ! Recieve from right comm0, status, ierr) END SUBROUTINE update_ghosts_p_e !Communicate p+1, p+2 moments to left neighboor and p-1, p-2 moments to right one SUBROUTINE update_ghosts_p_i IMPLICIT NONE count = (ijeg_i-ijsg_i+1)*(ikxe-ikxs+1)*(ikye-ikys+1)*(ize-izs+1) ! Number of elements sent !!!!!!!!!!! Send ghost to right neighbour !!!!!!!!!!!!!!!!!!!!!! CALL mpi_sendrecv(moments_i(ipe_i ,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 14, & moments_i(ips_i-1,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 14, & comm0, status, ierr) IF (deltapi .EQ. 1) & ! If we have odd Hermite degrees we need a 2nd order stencil CALL mpi_sendrecv(moments_i(ipe_i-1,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 15, & moments_i(ips_i-2,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 15, & comm0, status, ierr) !!!!!!!!!!! Send ghost to left neighbour !!!!!!!!!!!!!!!!!!!!!! CALL mpi_cart_shift(comm0, 0, -1, source , dest , ierr) CALL mpi_sendrecv(moments_i(ips_i ,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 16, & moments_i(ipe_i+1,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 16, & comm0, status, ierr) IF (deltapi .EQ. 1) & ! If we have odd Hermite degrees we need a 2nd order stencil CALL mpi_sendrecv(moments_i(ips_i+1,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_L, 17, & moments_i(ipe_i+2,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel), count, MPI_DOUBLE_COMPLEX, nbr_R, 17, & comm0, status, ierr) END SUBROUTINE update_ghosts_p_i END MODULE ghosts diff --git a/src/grid_mod.F90 b/src/grid_mod.F90 index 9a6d695..a2736db 100644 --- a/src/grid_mod.F90 +++ b/src/grid_mod.F90 @@ -1,451 +1,452 @@ MODULE grid ! Grid module for spatial discretization USE prec_const USE basic IMPLICIT NONE PRIVATE ! GRID Namelist INTEGER, PUBLIC, PROTECTED :: pmaxe = 1 ! The maximal electron Hermite-moment computed INTEGER, PUBLIC, PROTECTED :: jmaxe = 1 ! The maximal electron Laguerre-moment computed INTEGER, PUBLIC, PROTECTED :: pmaxi = 1 ! The maximal ion Hermite-moment computed INTEGER, PUBLIC, PROTECTED :: jmaxi = 1 ! The maximal ion Laguerre-moment computed INTEGER, PUBLIC, PROTECTED :: maxj = 1 ! The maximal Laguerre-moment INTEGER, PUBLIC, PROTECTED :: dmaxe = 1 ! The maximal full GF set of e-moments v^dmax INTEGER, PUBLIC, PROTECTED :: dmaxi = 1 ! The maximal full GF set of i-moments v^dmax INTEGER, PUBLIC, PROTECTED :: Nx = 16 ! Number of total internal grid points in x REAL(dp), PUBLIC, PROTECTED :: Lx = 1._dp ! horizontal length of the spatial box INTEGER, PUBLIC, PROTECTED :: Ny = 16 ! Number of total internal grid points in y REAL(dp), PUBLIC, PROTECTED :: Ly = 1._dp ! vertical length of the spatial box INTEGER, PUBLIC, PROTECTED :: Nz = 1 ! Number of total perpendicular planes REAL(dp), PUBLIC, PROTECTED :: q0 = 1._dp ! safety factor REAL(dp), PUBLIC, PROTECTED :: shear = 0._dp ! magnetic field shear REAL(dp), PUBLIC, PROTECTED :: eps = 0._dp ! inverse aspect ratio INTEGER, PUBLIC, PROTECTED :: Nkx = 8 ! Number of total internal grid points in kx REAL(dp), PUBLIC, PROTECTED :: Lkx = 1._dp ! horizontal length of the fourier box INTEGER, PUBLIC, PROTECTED :: Nky = 16 ! Number of total internal grid points in ky REAL(dp), PUBLIC, PROTECTED :: Lky = 1._dp ! vertical length of the fourier box REAL(dp), PUBLIC, PROTECTED :: kpar = 0_dp ! parallel wave vector component ! For Orszag filter REAL(dp), PUBLIC, PROTECTED :: two_third_kxmax REAL(dp), PUBLIC, PROTECTED :: two_third_kymax REAL(dp), PUBLIC, PROTECTED :: two_third_kpmax ! 1D Antialiasing arrays (2/3 rule) REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: AA_x REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: AA_y ! Grids containing position in physical space REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: xarray REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: yarray REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: zarray, zarray_full INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: izarray REAL(dp), PUBLIC, PROTECTED :: deltax, deltay, deltaz, inv_deltaz INTEGER, PUBLIC, PROTECTED :: ixs, ixe, iys, iye, izs, ize INTEGER, PUBLIC, PROTECTED :: izgs, izge ! ghosts INTEGER, PUBLIC :: ir,iz ! counters integer(C_INTPTR_T), PUBLIC :: local_nkx, local_nky integer(C_INTPTR_T), PUBLIC :: local_nkx_offset, local_nky_offset INTEGER, PUBLIC :: local_nkp INTEGER, PUBLIC :: local_np_e, local_np_i INTEGER, PUBLIC :: total_np_e, total_np_i integer(C_INTPTR_T), PUBLIC :: local_np_e_offset, local_np_i_offset INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: counts_np_e, counts_np_i INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: displs_np_e, displs_np_i ! Grids containing position in fourier space REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: kxarray, kxarray_full REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: kyarray, kyarray_full + REAL(dp), DIMENSION(:,:,:), ALLOCATABLE, PUBLIC :: kparray REAL(dp), PUBLIC, PROTECTED :: deltakx, deltaky, kx_max, ky_max!, kp_max REAL(dp), PUBLIC, PROTECTED :: local_kxmax, local_kymax INTEGER, PUBLIC, PROTECTED :: ikxs, ikxe, ikys, ikye!, ikps, ikpe INTEGER, PUBLIC, PROTECTED :: ikx_0, iky_0, ikx_max, iky_max ! Indices of k-grid origin and max INTEGER, PUBLIC :: ikx, iky, ip, ij, ikp, pp2 ! counters LOGICAL, PUBLIC, PROTECTED :: contains_kx0 = .false. ! flag if the proc contains kx=0 index LOGICAL, PUBLIC, PROTECTED :: contains_ky0 = .false. ! flag if the proc contains ky=0 index LOGICAL, PUBLIC, PROTECTED :: contains_kxmax = .false. ! flag if the proc contains kx=kxmax index ! Grid containing the polynomials degrees INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: parray_e, parray_e_full INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: parray_i, parray_i_full INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: jarray_e, jarray_e_full INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: jarray_i, jarray_i_full INTEGER, PUBLIC, PROTECTED :: ips_e,ipe_e, ijs_e,ije_e ! Start and end indices for pol. deg. INTEGER, PUBLIC, PROTECTED :: ips_i,ipe_i, ijs_i,ije_i INTEGER, PUBLIC, PROTECTED :: ipsg_e,ipeg_e, ijsg_e,ijeg_e ! Ghosts start and end indices INTEGER, PUBLIC, PROTECTED :: ipsg_i,ipeg_i, ijsg_i,ijeg_i INTEGER, PUBLIC, PROTECTED :: deltape, ip0_e, ip1_e, ip2_e ! Pgrid spacing and moment 0,1,2 index INTEGER, PUBLIC, PROTECTED :: deltapi, ip0_i, ip1_i, ip2_i ! Usefull inverse numbers REAL(dp), PUBLIC, PROTECTED :: inv_Nx, inv_Ny ! Public Functions PUBLIC :: init_1Dgrid_distr PUBLIC :: set_pgrid, set_jgrid PUBLIC :: set_kxgrid, set_kygrid, set_zgrid PUBLIC :: grid_readinputs, grid_outputinputs PUBLIC :: bare, bari ! Precomputations real(dp), PUBLIC, PROTECTED :: pmaxe_dp, pmaxi_dp, jmaxe_dp,jmaxi_dp CONTAINS SUBROUTINE grid_readinputs ! Read the input parameters USE prec_const IMPLICIT NONE INTEGER :: lu_in = 90 ! File duplicated from STDIN NAMELIST /GRID/ pmaxe, jmaxe, pmaxi, jmaxi, & Nx, Lx, Ny, Ly, Nz, q0, shear, eps READ(lu_in,grid) !! Compute the maximal degree of full GF moments set ! i.e. : all moments N_a^pj s.t. p+2j<=d are simulated (see GF closure) dmaxe = min(pmaxe,2*jmaxe+1) dmaxi = min(pmaxi,2*jmaxi+1) ! If no parallel dim (Nz=1), the moment hierarchy is separable between odds and even P !! and since the energy is injected in P=0 and P=2 for density/temperature gradients !! there is no need of simulating the odd p which will only be damped. !! We define in this case a grid Parray = 0,2,4,...,Pmax i.e. deltap = 2 instead of 1 !! to spare computation IF(Nz .EQ. 1) THEN deltape = 2; deltapi = 2; pp2 = 1; ! index p+2 is ip+1 ELSE deltape = 1; deltapi = 1; pp2 = 2; ! index p+2 is ip+1 ENDIF ! Usefull precomputations inv_Nx = 1._dp/REAL(Nx,dp) inv_Ny = 1._dp/REAL(Ny,dp) END SUBROUTINE grid_readinputs SUBROUTINE init_1Dgrid_distr ! write(*,*) Nx local_nkx = (Nx/2+1)/num_procs_kx ! write(*,*) local_nkx local_nkx_offset = rank_kx*local_nkx if (rank_kx .EQ. num_procs_kx-1) local_nkx = (Nx/2+1)-local_nkx_offset END SUBROUTINE init_1Dgrid_distr SUBROUTINE set_pgrid USE prec_const IMPLICIT NONE INTEGER :: ip, istart, iend, in ! Total number of Hermite polynomials we will evolve total_np_e = (Pmaxe/deltape) + 1 total_np_i = (Pmaxi/deltapi) + 1 ! Build the full grids on process 0 to diagnose it without comm ALLOCATE(parray_e_full(1:total_np_e)) ALLOCATE(parray_i_full(1:total_np_i)) ! P DO ip = 1,total_np_e; parray_e_full(ip) = (ip-1)*deltape; END DO DO ip = 1,total_np_i; parray_i_full(ip) = (ip-1)*deltapi; END DO !! Parallel data distribution ! Local data distribution CALL decomp1D(total_np_e, num_procs_p, rank_p, ips_e, ipe_e) CALL decomp1D(total_np_i, num_procs_p, rank_p, ips_i, ipe_i) local_np_e = ipe_e - ips_e + 1 local_np_i = ipe_i - ips_i + 1 ! Ghosts boundaries ipsg_e = ips_e - 2/deltape; ipeg_e = ipe_e + 2/deltape; ipsg_i = ips_i - 2/deltapi; ipeg_i = ipe_i + 2/deltapi; ! List of shift and local numbers between the different processes (used in scatterv and gatherv) ALLOCATE(counts_np_e (1:num_procs_p)) ALLOCATE(counts_np_i (1:num_procs_p)) ALLOCATE(displs_np_e (1:num_procs_p)) ALLOCATE(displs_np_i (1:num_procs_p)) DO in = 0,num_procs_p-1 CALL decomp1D(total_np_e, num_procs_p, in, istart, iend) counts_np_e(in+1) = iend-istart+1 displs_np_e(in+1) = istart-1 CALL decomp1D(total_np_i, num_procs_p, in, istart, iend) counts_np_i(in+1) = iend-istart+1 displs_np_i(in+1) = istart-1 ENDDO ! local grid computation ALLOCATE(parray_e(ipsg_e:ipeg_e)) ALLOCATE(parray_i(ipsg_i:ipeg_i)) DO ip = ipsg_e,ipeg_e parray_e(ip) = (ip-1)*deltape ! Storing indices of particular degrees for DG and fluid moments computations IF(parray_e(ip) .EQ. 0) ip0_e = ip IF(parray_e(ip) .EQ. 1) ip1_e = ip IF(parray_e(ip) .EQ. 2) ip2_e = ip END DO DO ip = ipsg_i,ipeg_i parray_i(ip) = (ip-1)*deltapi IF(parray_i(ip) .EQ. 0) ip0_i = ip IF(parray_i(ip) .EQ. 1) ip1_i = ip IF(parray_i(ip) .EQ. 2) ip2_i = ip END DO !DGGK operator uses moments at index p=2 (ip=3) for the p=0 term so the ! process that contains ip=1 MUST contain ip=3 as well for both e and i. IF(((ips_e .EQ. ip0_e) .OR. (ips_i .EQ. ip0_e)) .AND. ((ipe_e .LT. ip2_e) .OR. (ipe_i .LT. ip2_i)))& WRITE(*,*) "Warning : distribution along p may not work with DGGK" ! Precomputations pmaxe_dp = real(pmaxe,dp) pmaxi_dp = real(pmaxi,dp) END SUBROUTINE set_pgrid SUBROUTINE set_jgrid USE prec_const IMPLICIT NONE INTEGER :: ij ! Build the full grids on process 0 to diagnose it without comm ALLOCATE(jarray_e_full(1:jmaxe+1)) ALLOCATE(jarray_i_full(1:jmaxi+1)) ! J DO ij = 1,jmaxe+1; jarray_e_full(ij) = (ij-1); END DO DO ij = 1,jmaxi+1; jarray_i_full(ij) = (ij-1); END DO ! Local data ijs_e = 1; ije_e = jmaxe + 1 ijs_i = 1; ije_i = jmaxi + 1 ! Ghosts boundaries ijsg_e = ijs_e - 1; ijeg_e = ije_e + 1; ijsg_i = ijs_i - 1; ijeg_i = ije_i + 1; ALLOCATE(jarray_e(ijsg_e:ijeg_e)) ALLOCATE(jarray_i(ijsg_i:ijeg_i)) DO ij = ijsg_e,ijeg_e; jarray_e(ij) = ij-1; END DO DO ij = ijsg_i,ijeg_i; jarray_i(ij) = ij-1; END DO ! Precomputations maxj = MAX(jmaxi, jmaxe) jmaxe_dp = real(jmaxe,dp) jmaxi_dp = real(jmaxi,dp) END SUBROUTINE set_jgrid SUBROUTINE set_kxgrid USE prec_const USE model, ONLY: NON_LIN IMPLICIT NONE INTEGER :: i_ Nkx = Nx/2+1 ! Defined only on positive kx since fields are real ! Grid spacings IF (Nx .EQ. 1) THEN deltakx = 0._dp kx_max = 0._dp ELSE deltakx = 2._dp*PI/Lx kx_max = Nkx*deltakx ENDIF ! Build the full grids on process 0 to diagnose it without comm ALLOCATE(kxarray_full(1:Nkx)) DO ikx = 1,Nkx kxarray_full(ikx) = REAL(ikx-1,dp) * deltakx END DO !! Parallel distribution ! Start and END indices of grid ! ikxs = 1 ! ikxe = Nkx ikxs = local_nkx_offset + 1 ikxe = ikxs + local_nkx - 1 ALLOCATE(kxarray(ikxs:ikxe)) local_kxmax = 0._dp ! Creating a grid ordered as dk*(0 1 2 3) DO ikx = ikxs,ikxe kxarray(ikx) = REAL(ikx-1,dp) * deltakx ! Finding kx=0 IF (kxarray(ikx) .EQ. 0) THEN ikx_0 = ikx contains_kx0 = .true. ENDIF ! Finding local kxmax value IF (ABS(kxarray(ikx)) .GT. local_kxmax) THEN local_kxmax = ABS(kxarray(ikx)) ENDIF ! Finding kxmax idx IF (kxarray(ikx) .EQ. kx_max) THEN ikx_max = ikx contains_kxmax = .true. ENDIF END DO ! Orszag 2/3 filter two_third_kxmax = 2._dp/3._dp*deltakx*(Nkx-1) ALLOCATE(AA_x(ikxs:ikxe)) DO ikx = ikxs,ikxe IF ( (kxarray(ikx) .LT. two_third_kxmax) .OR. (.NOT. NON_LIN)) THEN AA_x(ikx) = 1._dp; ELSE AA_x(ikx) = 0._dp; ENDIF END DO END SUBROUTINE set_kxgrid SUBROUTINE set_kygrid USE prec_const USE model, ONLY: NON_LIN IMPLICIT NONE INTEGER :: i_, counter Nky = Ny; ALLOCATE(kyarray_full(1:Nky)) ! Local data ! Start and END indices of grid ikys = 1 ikye = Nky ALLOCATE(kyarray(ikys:ikye)) IF (Ny .EQ. 1) THEN ! "cancel" y dimension deltaky = 1._dp kyarray(1) = 0._dp iky_0 = 1 contains_ky0 = .true. ky_max = 0._dp iky_max = 1 kyarray_full(1) = 0._dp local_kymax = 0._dp ELSE ! Build apprpopriate grid deltaky = 2._dp*PI/Ly ky_max = (Ny/2)*deltakx ! Creating a grid ordered as dk*(0 1 2 3 -2 -1) local_kymax = 0._dp DO iky = ikys,ikye kyarray(iky) = deltaky*(MODULO(iky-1,Nky/2)-Nky/2*FLOOR(2.*real(iky-1)/real(Nky))) if (iky .EQ. Ny/2+1) kyarray(iky) = -kyarray(iky) ! Finding ky=0 IF (kyarray(iky) .EQ. 0) THEN iky_0 = iky contains_ky0 = .true. ENDIF ! Finding local kymax IF (ABS(kyarray(ikx)) .GT. local_kymax) THEN local_kymax = ABS(kyarray(iky)) ENDIF ! Finding kymax IF (kyarray(ikx) .EQ. ky_max) ikx_max = ikx END DO ! Build the full grids on process 0 to diagnose it without comm ! ky DO iky = 1,Nky kyarray_full(iky) = deltaky*(MODULO(iky-1,Nky/2)-Nky/2*FLOOR(2.*real(iky-1)/real(Nky))) IF (iky .EQ. Ny/2+1) kyarray_full(iky) = -kyarray_full(iky) END DO ENDIF ! Orszag 2/3 filter two_third_kymax = 2._dp/3._dp*deltaky*(Nky/2-1); ALLOCATE(AA_y(ikys:ikye)) DO iky = ikys,ikye IF ( ((kyarray(iky) .GT. -two_third_kymax) .AND. & (kyarray(iky) .LT. two_third_kymax)) .OR. (.NOT. NON_LIN)) THEN AA_y(iky) = 1._dp; ELSE AA_y(iky) = 0._dp; ENDIF END DO END SUBROUTINE set_kygrid SUBROUTINE set_zgrid USE prec_const IMPLICIT NONE INTEGER :: i_, ngz ! Start and END indices of grid izs = 1 ize = Nz ALLOCATE(zarray(izs:ize)) IF (Nz .EQ. 1) THEN ! full perp case deltaz = 1._dp zarray(1) = 0 ELSE deltaz = 2._dp*PI/REAL(Nz,dp) inv_deltaz = 1._dp/deltaz DO iz = izs,ize zarray(iz) = REAL((iz-1),dp)*deltaz - PI ENDDO ENDIF if(my_id.EQ.0) write(*,*) '#parallel planes = ', Nz ! Build the full grids on process 0 to diagnose it without comm ALLOCATE(zarray_full(1:Nz)) ! z from -pi to pi IF (Nz .GT. 1) THEN DO iz = 1,Nz zarray_full(iz) = deltaz*(iz-1) - PI END DO ELSE zarray_full(1) = 0 ENDIF ! Boundary conditions for FDF ddz derivative ! 4 stencil deritative -> 2 ghosts each sides ngz = 2 ALLOCATE(izarray((1-ngz):(Nz+ngz))) DO iz = 1,Nz izarray(iz) = iz !points to usuall indices END DO ! Periodic BC for parallel centered finite differences izarray(-1) = Nz-1; izarray(0) = Nz; izarray(Nz+1) = 1; izarray(Nz+2) = 2; END SUBROUTINE set_zgrid SUBROUTINE grid_outputinputs(fidres, str) ! Write the input parameters to the results_xx.h5 file USE futils, ONLY: attach USE prec_const IMPLICIT NONE INTEGER, INTENT(in) :: fidres CHARACTER(len=256), INTENT(in) :: str CALL attach(fidres, TRIM(str), "pmaxe", pmaxe) CALL attach(fidres, TRIM(str), "jmaxe", jmaxe) CALL attach(fidres, TRIM(str), "pmaxi", pmaxi) CALL attach(fidres, TRIM(str), "jmaxi", jmaxi) CALL attach(fidres, TRIM(str), "Nx", Nx) CALL attach(fidres, TRIM(str), "Lx", Lx) CALL attach(fidres, TRIM(str), "Ny", Ny) CALL attach(fidres, TRIM(str), "Ly", Ly) CALL attach(fidres, TRIM(str), "Nz", Nz) CALL attach(fidres, TRIM(str), "q0", q0) CALL attach(fidres, TRIM(str),"shear",shear) CALL attach(fidres, TRIM(str), "eps", eps) CALL attach(fidres, TRIM(str), "Nkx", Nkx) CALL attach(fidres, TRIM(str), "Lkx", Lkx) CALL attach(fidres, TRIM(str), "Nky", Nky) CALL attach(fidres, TRIM(str), "Lky", Lky) END SUBROUTINE grid_outputinputs FUNCTION bare(p_,j_) IMPLICIT NONE INTEGER :: bare, p_, j_ bare = (jmaxe+1)*p_ + j_ + 1 END FUNCTION FUNCTION bari(p_,j_) IMPLICIT NONE INTEGER :: bari, p_, j_ bari = (jmaxi+1)*p_ + j_ + 1 END FUNCTION SUBROUTINE decomp1D( n, numprocs, myid, s, e ) INTEGER :: n, numprocs, myid, s, e INTEGER :: nlocal INTEGER :: deficit nlocal = n / numprocs s = myid * nlocal + 1 deficit = MOD(n,numprocs) s = s + MIN(myid,deficit) IF (myid .LT. deficit) nlocal = nlocal + 1 e = s + nlocal - 1 IF (e .GT. n .OR. myid .EQ. numprocs-1) e = n END SUBROUTINE decomp1D END MODULE grid diff --git a/src/inital.F90 b/src/inital.F90 index 3bac2e8..0627b10 100644 --- a/src/inital.F90 +++ b/src/inital.F90 @@ -1,354 +1,355 @@ !******************************************************************************! !!!!!! initialize the moments and load/build coeff tables !******************************************************************************! SUBROUTINE inital USE basic USE model, ONLY : CO, NON_LIN USE initial_par USE prec_const USE time_integration USE array, ONLY : Sepj,Sipj USE collision USE closure USE ghosts USE restarts USE numerics, ONLY: wipe_turbulence, wipe_zonalflow USE processing, ONLY: compute_nadiab_moments IMPLICIT NONE CALL set_updatetlevel(1) !!!!!! Set the moments arrays Nepj, Nipj and phi!!!!!! ! through loading a previous state IF ( job2load .GE. 0 ) THEN IF (my_id .EQ. 0) WRITE(*,*) 'Load moments' CALL load_moments ! get N_0 CALL poisson ! compute phi_0=phi(N_0) ! through initialization ELSE ! set phi with noise and set moments to 0 IF (INIT_NOISY_PHI) THEN IF (my_id .EQ. 0) WRITE(*,*) 'Init noisy phi' CALL init_phi ! set moments_00 (GC density) with noise and compute phi afterwards ELSE IF (my_id .EQ. 0) WRITE(*,*) 'Init noisy gyrocenter density' CALL init_gyrodens ! init only gyrocenter density ! CALL init_moments ! init all moments randomly (unadvised) CALL poisson ! get phi_0 = phi(N_0) ENDIF ENDIF ! Option for wiping the ZF modes (ky==0) IF ( WIPE_ZF .GT. 0 ) THEN IF (my_id .EQ. 0) WRITE(*,*) '-Wiping ZF modes' CALL wipe_zonalflow ENDIF ! Option for wiping the turbulence and check growth of secondary inst. IF ( WIPE_TURB .GT. 0 ) THEN IF (my_id .EQ. 0) WRITE(*,*) '-Wiping turbulence' CALL wipe_turbulence ENDIF ! Option for initializing a gaussian blob on the zonal profile IF ( INIT_BLOB ) THEN IF (my_id .EQ. 0) WRITE(*,*) '--init a blob' CALL initialize_blob ENDIF IF (my_id .EQ. 0) WRITE(*,*) 'Apply closure' CALL apply_closure_model IF (my_id .EQ. 0) WRITE(*,*) 'Ghosts communication' CALL update_ghosts IF (my_id .EQ. 0) WRITE(*,*) 'Computing non adiab moments' CALL compute_nadiab_moments !!!!!! Set Sepj, Sipj and dnjs coeff table !!!!!! IF ( NON_LIN ) THEN; IF (my_id .EQ. 0) WRITE(*,*) 'Init Sapj' CALL compute_Sapj ! compute S_0 = S(phi_0,N_0) ENDIF !!!!!! Load the COSOlver collision operator coefficients !!!!!! IF (ABS(CO) .GT. 1) THEN CALL load_COSOlver_mat ! Compute collision CALL compute_TColl ! compute C_0 = C(N_0) ENDIF END SUBROUTINE inital !******************************************************************************! !******************************************************************************! !!!!!!! Initialize all the moments randomly !******************************************************************************! SUBROUTINE init_moments USE basic USE grid USE fields USE prec_const USE utility, ONLY: checkfield USE initial_par USE model, ONLY : NON_LIN IMPLICIT NONE REAL(dp) :: noise REAL(dp) :: kx, ky, sigma, gain, ky_shift INTEGER, DIMENSION(12) :: iseedarr ! Seed random number generator iseedarr(:)=iseed CALL RANDOM_SEED(PUT=iseedarr+my_id) !**** Broad noise initialization ******************************************* DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize CALL RANDOM_NUMBER(noise) moments_e(ip,ij,ikx,iky,iz,:) = (init_background + init_noiselvl*(noise-0.5_dp)) END DO END DO END DO IF ( contains_kx0 ) THEN DO iky=2,Nky/2 !symmetry at kx = 0 for all z moments_e(ip,ij,ikx_0,iky,:,:) = moments_e( ip,ij,ikx_0,Nky+2-iky,:, :) END DO ENDIF END DO END DO DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize CALL RANDOM_NUMBER(noise) moments_i(ip,ij,ikx,iky,iz,:) = (init_background + init_noiselvl*(noise-0.5_dp)) END DO END DO END DO IF ( contains_kx0 ) THEN DO iky=2,Nky/2 !symmetry at kx = 0 for all z moments_i( ip,ij,ikx_0,iky,:,:) = moments_i( ip,ij,ikx_0,Nky+2-iky,:,:) END DO ENDIF END DO END DO ! Putting to zero modes that are not in the 2/3 Orszag rule IF (NON_LIN) THEN DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e moments_e( ip,ij,ikx,iky,iz, :) = moments_e( ip,ij,ikx,iky,iz, :)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i moments_i( ip,ij,ikx,iky,iz, :) = moments_i( ip,ij,ikx,iky,iz, :)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO ENDDO ENDDO ENDDO ENDIF END SUBROUTINE init_moments !******************************************************************************! !******************************************************************************! !!!!!!! Initialize the gyrocenter density randomly !******************************************************************************! SUBROUTINE init_gyrodens USE basic USE grid USE fields USE prec_const USE utility, ONLY: checkfield USE initial_par USE model, ONLY : NON_LIN IMPLICIT NONE REAL(dp) :: noise REAL(dp) :: kx, ky, sigma, gain, ky_shift INTEGER, DIMENSION(12) :: iseedarr ! Seed random number generator iseedarr(:)=iseed CALL RANDOM_SEED(PUT=iseedarr+my_id) !**** Broad noise initialization ******************************************* DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize CALL RANDOM_NUMBER(noise) IF ( (ip .EQ. 1) .AND. (ij .EQ. 1) ) THEN moments_e(ip,ij,ikx,iky,iz,:) = (init_background + init_noiselvl*(noise-0.5_dp)) ELSE moments_e(ip,ij,ikx,iky,iz,:) = 0._dp ENDIF END DO END DO END DO IF ( contains_kx0 ) THEN DO iky=2,Nky/2 !symmetry at kx = 0 for all z moments_e(ip,ij,ikx_0,iky,:,:) = moments_e( ip,ij,ikx_0,Nky+2-iky,:, :) END DO ENDIF END DO END DO DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize CALL RANDOM_NUMBER(noise) IF ( (ip .EQ. 1) .AND. (ij .EQ. 1) ) THEN moments_i(ip,ij,ikx,iky,iz,:) = (init_background + init_noiselvl*(noise-0.5_dp)) ELSE moments_i(ip,ij,ikx,iky,iz,:) = 0._dp ENDIF END DO END DO END DO IF ( contains_kx0 ) THEN DO iky=2,Nky/2 !symmetry at kx = 0 for all z moments_i( ip,ij,ikx_0,iky,:,:) = moments_i( ip,ij,ikx_0,Nky+2-iky,:,:) END DO ENDIF END DO END DO ! Putting to zero modes that are not in the 2/3 Orszag rule IF (NON_LIN) THEN DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e moments_e( ip,ij,ikx,iky,iz, :) = moments_e( ip,ij,ikx,iky,iz, :)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i moments_i( ip,ij,ikx,iky,iz, :) = moments_i( ip,ij,ikx,iky,iz, :)*AA_x(ikx)*AA_y(iky) ENDDO ENDDO ENDDO ENDDO ENDDO ENDIF END SUBROUTINE init_gyrodens !******************************************************************************! !******************************************************************************! !!!!!!! Initialize a noisy ES potential and cancel the moments !******************************************************************************! SUBROUTINE init_phi USE basic USE grid USE fields USE prec_const USE initial_par IMPLICIT NONE REAL(dp) :: noise - REAL(dp) :: kx, ky, sigma, gain, ky_shift + REAL(dp) :: kx, ky, kp, sigma, gain, ky_shift INTEGER, DIMENSION(12) :: iseedarr ! Seed random number generator iseedarr(:)=iseed CALL RANDOM_SEED(PUT=iseedarr+my_id) !**** noise initialization ******************************************* DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize + kp = kparray(ikx,iky,iz) CALL RANDOM_NUMBER(noise) - phi(ikx,iky,iz) = (init_background + init_noiselvl*(noise-0.5_dp))!*AA_x(ikx)*AA_y(iky) + phi(ikx,iky,iz) = (init_background + init_noiselvl*(noise-0.5_dp))*EXP(-0.1*kp**2)!*AA_x(ikx)*AA_y(iky) ENDDO END DO END DO !symmetry at kx = 0 to keep real inverse transform IF ( contains_kx0 ) THEN DO iky=2,Nky/2 phi(ikx_0,iky,:) = phi(ikx_0,Nky+2-iky,:) END DO phi(ikx_0,Ny/2,:) = REAL(phi(ikx_0,Ny/2,:)) !origin must be real ENDIF !**** ensure no previous moments initialization moments_e = 0._dp; moments_i = 0._dp !**** Zonal Flow initialization ******************************************* ! put a mode at ikx = mode number + 1, symmetry is already included since kx>=0 IF(INIT_ZF .GT. 0) THEN IF (my_id .EQ. 0) WRITE(*,*) 'Init ZF phi' IF( (INIT_ZF+1 .GT. ikxs) .AND. (INIT_ZF+1 .LT. ikxe) ) THEN DO iz = izs,ize phi(INIT_ZF+1,iky_0,iz) = ZF_AMP*(2._dp*PI)**2/deltakx/deltaky/2._dp * COS((iz-1)/Nz*2._dp*PI) moments_i(1,1,INIT_ZF+1,iky_0,iz,:) = kxarray(INIT_ZF+1)**2*phi(INIT_ZF+1,iky_0,iz)* COS((iz-1)/Nz*2._dp*PI) moments_e(1,1,INIT_ZF+1,iky_0,iz,:) = 0._dp ENDDO ENDIF ENDIF END SUBROUTINE init_phi !******************************************************************************! !******************************************************************************! !******************************************************************************! !!!!!!! Initialize an ionic Gaussian blob on top of the preexisting modes !******************************************************************************! SUBROUTINE initialize_blob USE fields USE grid USE model, ONLY: sigmai2_taui_o2 IMPLICIT NONE REAL(dp) ::kx, ky, sigma, gain sigma = 0.5_dp gain = 5e2_dp DO ikx=ikxs,ikxe kx = kxarray(ikx) DO iky=ikys,ikye ky = kyarray(iky) DO iz=izs,ize DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i IF( (iky .NE. iky_0) .AND. (ip .EQ. 1) .AND. (ij .EQ. 1)) THEN moments_i( ip,ij,ikx,iky,iz, :) = moments_i( ip,ij,ikx,iky,iz, :) & + gain*sigma/SQRT2 * exp(-(kx**2+ky**2)*sigma**2/4._dp) & * AA_x(ikx)*AA_y(iky)!& ! * exp(sigmai2_taui_o2*(kx**2+ky**2)) ENDIF ENDDO ENDDO ENDDO ENDDO ENDDO END SUBROUTINE initialize_blob !******************************************************************************! diff --git a/src/memory.F90 b/src/memory.F90 index e6dc6a2..0cfc320 100644 --- a/src/memory.F90 +++ b/src/memory.F90 @@ -1,128 +1,118 @@ SUBROUTINE memory ! Allocate arrays (done dynamically otherwise size is unknown) USE array USE basic USE fields USE grid USE time_integration - USE model, ONLY: CO, NON_LIN + USE model, ONLY: CO, NON_LIN, KIN_E USE prec_const IMPLICIT NONE - !___________________ 2D ARRAYS __________________________ + ! Electrostatic potential CALL allocate_array(phi, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array(inv_poisson_op, ikxs,ikxe, ikys,ikye, izs,ize) + + !Electrons arrays + IF(KIN_E) THEN + CALL allocate_array( Ne00, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( dens_e, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( temp_e, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( Kernel_e, ijsg_e,ijeg_e, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( moments_e, ipsg_e,ipeg_e, ijsg_e,ijeg_e, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) + CALL allocate_array( moments_rhs_e, ips_e,ipe_e, ijs_e,ije_e, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) + CALL allocate_array( nadiab_moments_e, ipsg_e,ipeg_e, ijsg_e,ijeg_e, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( TColl_e, ips_e,ipe_e, ijs_e,ije_e , ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( Sepj, ips_e,ipe_e, ijs_e,ije_e, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( xnepj, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( xnepp2j, ips_e,ipe_e) + CALL allocate_array( xnepp1j, ips_e,ipe_e) + CALL allocate_array( xnepm1j, ips_e,ipe_e) + CALL allocate_array( xnepm2j, ips_e,ipe_e) + CALL allocate_array( xnepjp1, ijs_e,ije_e) + CALL allocate_array( xnepjm1, ijs_e,ije_e) + CALL allocate_array( ynepp1j, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( ynepm1j, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( ynepp1jm1, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( ynepm1jm1, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( zNepm1j, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( zNepm1jp1, ips_e,ipe_e, ijs_e,ije_e) + CALL allocate_array( zNepm1jm1, ips_e,ipe_e, ijs_e,ije_e) + ENDIF - !! Diagnostics arrays - ! Gyrocenter density *for 2D output* - CALL allocate_array(Ne00, ikxs,ikxe, ikys,ikye, izs,ize) + !Ions arrays CALL allocate_array(Ni00, ikxs,ikxe, ikys,ikye, izs,ize) - ! particle density *for 2D output* - CALL allocate_array(dens_e, ikxs,ikxe, ikys,ikye, izs,ize) CALL allocate_array(dens_i, ikxs,ikxe, ikys,ikye, izs,ize) - ! particle temperature *for 2D output* - CALL allocate_array(temp_e, ikxs,ikxe, ikys,ikye, izs,ize) CALL allocate_array(temp_i, ikxs,ikxe, ikys,ikye, izs,ize) - - !___________________ 4D ARRAYS __________________________ - !! FLR kernels functions - ! Kernel evaluation from j= -1 to jmax+1 for truncation - CALL allocate_array(Kernel_e, ijsg_e,ijeg_e, ikxs,ikxe, ikys,ikye, izs,ize) - CALL allocate_array(Kernel_i, ijsg_i,ijeg_i, ikxs,ikxe, ikys,ikye, izs,ize) - - !___________________ 5D ARRAYS __________________________ - ! Moments with ghost degrees for p+2 p-2, j+1, j-1 truncations - CALL allocate_array( moments_e, ipsg_e,ipeg_e, ijsg_e,ijeg_e, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) - CALL allocate_array( moments_i, ipsg_i,ipeg_i, ijsg_i,ijeg_i, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) - - ! Moments right-hand-side (contains linear part of hierarchy) - CALL allocate_array( moments_rhs_e, ips_e,ipe_e, ijs_e,ije_e, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) - CALL allocate_array( moments_rhs_i, ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) - - ! Non linear terms and dnjs table - CALL allocate_array( nadiab_moments_e, ipsg_e,ipeg_e, ijsg_e,ijeg_e, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( Kernel_i, ijsg_i,ijeg_i, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( moments_i, ipsg_i,ipeg_i, ijsg_i,ijeg_i, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) + CALL allocate_array( moments_rhs_i, ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize, 1,ntimelevel ) CALL allocate_array( nadiab_moments_i, ipsg_i,ipeg_i, ijsg_i,ijeg_i, ikxs,ikxe, ikys,ikye, izs,ize) - - ! Collision term - CALL allocate_array( TColl_e, ips_e,ipe_e, ijs_e,ije_e , ikxs,ikxe, ikys,ikye, izs,ize) - CALL allocate_array( TColl_i, ips_i,ipe_i, ijs_i,ije_i , ikxs,ikxe, ikys,ikye, izs,ize) - - ! Non linear terms and dnjs table - CALL allocate_array( Sepj, ips_e,ipe_e, ijs_e,ije_e, ikxs,ikxe, ikys,ikye, izs,ize) - CALL allocate_array( Sipj, ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize) - CALL allocate_array( dnjs, 1,maxj+1, 1,maxj+1, 1,maxj+1) - - ! Linear coeff for moments rhs - ! electrons - CALL allocate_array( xnepj, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( xnepp2j, ips_e,ipe_e) - CALL allocate_array( xnepp1j, ips_e,ipe_e) - CALL allocate_array( xnepm1j, ips_e,ipe_e) - CALL allocate_array( xnepm2j, ips_e,ipe_e) - CALL allocate_array( xnepjp1, ijs_e,ije_e) - CALL allocate_array( xnepjm1, ijs_e,ije_e) - CALL allocate_array( ynepp1j, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( ynepm1j, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( ynepp1jm1, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( ynepm1jm1, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( zNepm1j, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( zNepm1jp1, ips_e,ipe_e, ijs_e,ije_e) - CALL allocate_array( zNepm1jm1, ips_e,ipe_e, ijs_e,ije_e) - ! ions + CALL allocate_array( TColl_i, ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize) + CALL allocate_array( Sipj, ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize) CALL allocate_array( xnipj, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( xnipp2j, ips_i,ipe_i) CALL allocate_array( xnipp1j, ips_i,ipe_i) CALL allocate_array( xnipm1j, ips_i,ipe_i) CALL allocate_array( xnipm2j, ips_i,ipe_i) CALL allocate_array( xnipjp1, ijs_i,ije_i) CALL allocate_array( xnipjm1, ijs_i,ije_i) CALL allocate_array( ynipp1j, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( ynipm1j, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( ynipp1jm1, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( ynipm1jm1, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( zNipm1j, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( zNipm1jp1, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( zNipm1jm1, ips_i,ipe_i, ijs_i,ije_i) - ! elect. pot. + + ! Non linear terms and dnjs table + CALL allocate_array( dnjs, 1,maxj+1, 1,maxj+1, 1,maxj+1) + + ! elect. pot. linear terms CALL allocate_array( xphij, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( xphijp1, ips_i,ipe_i, ijs_i,ije_i) CALL allocate_array( xphijm1, ips_i,ipe_i, ijs_i,ije_i) ! Curvature and geometry CALL allocate_array( Ckxky, ikxs,ikxe, ikys,ikye, izs,ize) CALL allocate_array( kparray, ikxs,ikxe, ikys,ikye, izs,ize) CALL allocate_array(Jacobian,izs,ize) CALL allocate_array(gxx, izs,ize) CALL allocate_array(gxy, izs,ize) CALL allocate_array(gyy, izs,ize) CALL allocate_array(gyz, izs,ize) CALL allocate_array(gxz, izs,ize) CALL allocate_array(gradzB,izs,ize) CALL allocate_array(gradxB,izs,ize) CALL allocate_array(hatB,izs,ize) CALL allocate_array(hatR,izs,ize) CALL allocate_array(Gamma1, izs,ize) call allocate_array(Gamma2, izs,ize) call allocate_array(Gamma3, izs, ize) call allocate_array(gradz_coeff, izs, ize) !___________________ 2x5D ARRAYS __________________________ !! Collision matrices IF (CO .LT. -1) THEN !DK collision matrix (same for every k) + IF (KIN_E) THEN CALL allocate_array( Ceepj, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), 1,1, 1,1) CALL allocate_array( CeipjT, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), 1,1, 1,1) CALL allocate_array( CeipjF, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxi+1)*(jmaxi+1), 1,1, 1,1) - CALL allocate_array( Ciipj, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), 1,1, 1,1) CALL allocate_array( CiepjT, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), 1,1, 1,1) CALL allocate_array( CiepjF, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxe+1)*(jmaxe+1), 1,1, 1,1) + ENDIF + CALL allocate_array( Ciipj, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), 1,1, 1,1) ELSEIF (CO .GT. 1) THEN !GK collision matrices (one for each kperp) + IF (KIN_E) THEN CALL allocate_array( Ceepj, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikxs,ikxe, ikys,ikye) CALL allocate_array( CeipjT, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikxs,ikxe, ikys,ikye) CALL allocate_array( CeipjF, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxi+1)*(jmaxi+1), ikxs,ikxe, ikys,ikye) - CALL allocate_array( Ciipj, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), ikxs,ikxe, ikys,ikye) CALL allocate_array( CiepjT, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), ikxs,ikxe, ikys,ikye) CALL allocate_array( CiepjF, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxe+1)*(jmaxe+1), ikxs,ikxe, ikys,ikye) + ENDIF + CALL allocate_array( Ciipj, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), ikxs,ikxe, ikys,ikye) ENDIF END SUBROUTINE memory diff --git a/src/model_mod.F90 b/src/model_mod.F90 index 10bde0b..dac8b66 100644 --- a/src/model_mod.F90 +++ b/src/model_mod.F90 @@ -1,119 +1,121 @@ MODULE model ! Module for diagnostic parameters USE prec_const IMPLICIT NONE PRIVATE INTEGER, PUBLIC, PROTECTED :: CO = 0 ! Collision Operator INTEGER, PUBLIC, PROTECTED :: CLOS = 0 ! linear truncation method INTEGER, PUBLIC, PROTECTED :: NL_CLOS = 0 ! nonlinear truncation method INTEGER, PUBLIC, PROTECTED :: KERN = 0 ! Kernel model LOGICAL, PUBLIC, PROTECTED :: NON_LIN = .true. ! To turn on non linear bracket term + LOGICAL, PUBLIC, PROTECTED :: KIN_E = .true. ! Simulate kinetic electron (adiabatic otherwise) REAL(dp), PUBLIC, PROTECTED :: mu = 0._dp ! spatial Hyperdiffusivity coefficient (for num. stability) REAL(dp), PUBLIC, PROTECTED :: mu_p = 0._dp ! kinetic para hyperdiffusivity coefficient (for num. stability) REAL(dp), PUBLIC, PROTECTED :: mu_j = 0._dp ! kinetic perp hyperdiffusivity coefficient (for num. stability) REAL(dp), PUBLIC, PROTECTED :: nu = 1._dp ! Collision frequency REAL(dp), PUBLIC, PROTECTED :: tau_e = 1._dp ! Temperature REAL(dp), PUBLIC, PROTECTED :: tau_i = 1._dp ! REAL(dp), PUBLIC, PROTECTED :: sigma_e = 1._dp ! Mass REAL(dp), PUBLIC, PROTECTED :: sigma_i = 1._dp ! REAL(dp), PUBLIC, PROTECTED :: q_e = -1._dp ! Charge REAL(dp), PUBLIC, PROTECTED :: q_i = 1._dp ! REAL(dp), PUBLIC, PROTECTED :: K_n = 1._dp ! Density drive REAL(dp), PUBLIC, PROTECTED :: K_T = 0._dp ! Temperature drive REAL(dp), PUBLIC, PROTECTED :: K_E = 0._dp ! Backg. electric field drive REAL(dp), PUBLIC, PROTECTED :: GradB = 1._dp ! Magnetic gradient REAL(dp), PUBLIC, PROTECTED :: CurvB = 1._dp ! Magnetic curvature REAL(dp), PUBLIC, PROTECTED :: lambdaD = 1._dp ! Debye length REAL(dp), PUBLIC, PROTECTED :: taue_qe ! factor of the magnetic moment coupling REAL(dp), PUBLIC, PROTECTED :: taui_qi ! REAL(dp), PUBLIC, PROTECTED :: qi_taui ! REAL(dp), PUBLIC, PROTECTED :: qe_taue ! REAL(dp), PUBLIC, PROTECTED :: sqrtTaue_qe ! factor of parallel moment term REAL(dp), PUBLIC, PROTECTED :: sqrtTaui_qi ! REAL(dp), PUBLIC, PROTECTED :: qe_sigmae_sqrtTaue ! factor of parallel phi term REAL(dp), PUBLIC, PROTECTED :: qi_sigmai_sqrtTaui ! REAL(dp), PUBLIC, PROTECTED :: sigmae2_taue_o2 ! factor of the Kernel argument REAL(dp), PUBLIC, PROTECTED :: sigmai2_taui_o2 ! REAL(dp), PUBLIC, PROTECTED :: sqrt_sigmae2_taue_o2 ! factor of the Kernel argument - REAL(dp), PUBLIC, PROTECTED :: sqrt_sigmai2_taui_o2 + REAL(dp), PUBLIC, PROTECTED :: sqrt_sigmai2_taui_o2 REAL(dp), PUBLIC, PROTECTED :: nu_e, nu_i ! electron-ion, ion-ion collision frequency REAL(dp), PUBLIC, PROTECTED :: nu_ee, nu_ie ! e-e, i-e coll. frequ. REAL(dp), PUBLIC, PROTECTED :: qe2_taue, qi2_taui ! factor of the gammaD sum PUBLIC :: model_readinputs, model_outputinputs CONTAINS SUBROUTINE model_readinputs ! Read the input parameters USE basic, ONLY : lu_in USE prec_const IMPLICIT NONE - NAMELIST /MODEL_PAR/ CO, CLOS, NL_CLOS, KERN, NON_LIN, mu, mu_p, mu_j, nu, tau_e, tau_i, sigma_e, sigma_i, & + NAMELIST /MODEL_PAR/ CO, CLOS, NL_CLOS, KERN, NON_LIN, KIN_E, mu, mu_p, mu_j, nu, tau_e, tau_i, sigma_e, sigma_i, & q_e, q_i, K_n, K_T, K_E, GradB, CurvB, lambdaD READ(lu_in,model_par) taue_qe = tau_e/q_e ! factor of the magnetic moment coupling taui_qi = tau_i/q_i ! factor of the magnetic moment coupling qe_taue = q_e/tau_e qi_taui = q_i/tau_i sqrtTaue_qe = sqrt(tau_e)/q_e ! factor of parallel moment term sqrtTaui_qi = sqrt(tau_i)/q_i ! factor of parallel moment term qe_sigmae_sqrtTaue = q_e/sigma_e/SQRT(tau_e) ! factor of parallel phi term qi_sigmai_sqrtTaui = q_i/sigma_i/SQRT(tau_i) qe2_taue = (q_e**2)/tau_e ! factor of the gammaD sum qi2_taui = (q_i**2)/tau_i sigmae2_taue_o2 = sigma_e**2 * tau_e/2._dp ! factor of the Kernel argument sigmai2_taui_o2 = sigma_i**2 * tau_i/2._dp sqrt_sigmae2_taue_o2 = SQRT(sigma_e**2 * tau_e/2._dp) ! to avoid multiple SQRT eval sqrt_sigmai2_taui_o2 = SQRT(sigma_i**2 * tau_i/2._dp) !! We use the ion-ion collision as normalization with definition ! nu_ii = 4 sqrt(pi)/3 T_i^(-3/2) m_i^(-1/2) q^4 n_i0 ln(Lambda) ! nu_e = nu/sigma_e * (tau_e)**(3._dp/2._dp) ! electron-ion collision frequency (where already multiplied by 0.532) nu_i = nu ! ion-ion collision frequ. nu_ee = nu_e ! e-e coll. frequ. nu_ie = nu_i ! i-e coll. frequ. ! Old normalization (MOLI Jorge/Frei) ! nu_e = 0.532_dp*nu ! electron-ion collision frequency (where already multiplied by 0.532) ! nu_i = 0.532_dp*nu*sigma_e*tau_e**(-3._dp/2._dp)/SQRT2 ! ion-ion collision frequ. ! nu_ee = nu_e/SQRT2 ! e-e coll. frequ. ! nu_ie = 0.532_dp*nu*sigma_e**2 ! i-e coll. frequ. END SUBROUTINE model_readinputs SUBROUTINE model_outputinputs(fidres, str) ! Write the input parameters to the results_xx.h5 file USE futils, ONLY: attach USE prec_const IMPLICIT NONE INTEGER, INTENT(in) :: fidres CHARACTER(len=256), INTENT(in) :: str CALL attach(fidres, TRIM(str), "CO", CO) CALL attach(fidres, TRIM(str), "CLOS", CLOS) CALL attach(fidres, TRIM(str), "KERN", KERN) CALL attach(fidres, TRIM(str), "NON_LIN", NON_LIN) + CALL attach(fidres, TRIM(str), "KIN_E", KIN_E) CALL attach(fidres, TRIM(str), "nu", nu) CALL attach(fidres, TRIM(str), "mu", mu) CALL attach(fidres, TRIM(str), "tau_e", tau_e) CALL attach(fidres, TRIM(str), "tau_i", tau_i) CALL attach(fidres, TRIM(str), "sigma_e", sigma_e) CALL attach(fidres, TRIM(str), "sigma_i", sigma_i) CALL attach(fidres, TRIM(str), "q_e", q_e) CALL attach(fidres, TRIM(str), "q_i", q_i) - CALL attach(fidres, TRIM(str), "K_n", K_n) - CALL attach(fidres, TRIM(str), "K_T", K_T) - CALL attach(fidres, TRIM(str), "K_E", K_E) + CALL attach(fidres, TRIM(str), "K_n", K_n) + CALL attach(fidres, TRIM(str), "K_T", K_T) + CALL attach(fidres, TRIM(str), "K_E", K_E) CALL attach(fidres, TRIM(str), "lambdaD", lambdaD) END SUBROUTINE model_outputinputs END MODULE model diff --git a/src/moments_eq_rhs.F90 b/src/moments_eq_rhs.F90 index 1660a18..34a424d 100644 --- a/src/moments_eq_rhs.F90 +++ b/src/moments_eq_rhs.F90 @@ -1,290 +1,294 @@ !_____________________________________________________________________________! !_____________________________________________________________________________! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!! Electrons moments RHS !!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !_____________________________________________________________________________! SUBROUTINE moments_eq_rhs_e USE basic USE time_integration USE array USE fields USE grid USE model USE prec_const USE collision use geometry IMPLICIT NONE INTEGER :: p_int, j_int ! loops indices and polynom. degrees REAL(dp) :: kx, ky, kperp2, dzlnB_o_J COMPLEX(dp) :: Tnepj, Tnepp2j, Tnepm2j, Tnepjp1, Tnepjm1, Tpare, Tphi ! Terms from b x gradB and drives COMPLEX(dp) :: Tmir, Tnepp1j, Tnepm1j, Tnepp1jm1, Tnepm1jm1 ! Terms from mirror force with non adiab moments COMPLEX(dp) :: UNepm1j, UNepm1jp1, UNepm1jm1 ! Terms from mirror force with adiab moments COMPLEX(dp) :: TColl ! terms of the rhs COMPLEX(dp) :: i_ky REAL(dp) :: delta_p0, delta_p1, delta_p2 INTEGER :: izm2, izm1, izp1, izp2 ! indices for centered FDF ddz ! Measuring execution time CALL cpu_time(t0_rhs) ploope : DO ip = ips_e, ipe_e ! loop over Hermite degree indices p_int = parray_e(ip) ! Hermite polynom. degree delta_p0 = 0._dp; delta_p1 = 0._dp; delta_p2 = 0._dp IF(p_int .EQ. 0) delta_p0 = 1._dp IF(p_int .EQ. 1) delta_p1 = 1._dp IF(p_int .EQ. 2) delta_p2 = 1._dp jloope : DO ij = ijs_e, ije_e ! loop over Laguerre degree indices j_int = jarray_e(ij) ! Loop on kspace zloope : DO iz = izs,ize ! Obtain the index with an array that accounts for boundary conditions ! e.g. : 4 stencil with periodic BC, izarray(Nz+2) = 2, izarray(-1) = Nz-1 izp1 = izarray(iz+1); izp2 = izarray(iz+2); izm1 = izarray(iz-1); izm2 = izarray(iz-2); ! kxloope : DO ikx = ikxs,ikxe kx = kxarray(ikx) ! radial wavevector kyloope : DO iky = ikys,ikye ky = kyarray(iky) ! toroidal wavevector i_ky = imagu * ky ! toroidal derivative IF (Nky .EQ. 1) i_ky = imagu * kxarray(ikx) ! If 1D simulation we put kx as ky ! kperp2= gxx(iz)*kx**2 + 2._dp*gxy(iz)*kx*ky + gyy(iz)*ky**2 kperp2= kparray(ikx,iky,iz)**2 !! Compute moments mixing terms ! Perpendicular dynamic ! term propto n_e^{p,j} Tnepj = xnepj(ip,ij)* nadiab_moments_e(ip,ij,ikx,iky,iz) ! term propto n_e^{p+2,j} Tnepp2j = xnepp2j(ip) * nadiab_moments_e(ip+pp2,ij,ikx,iky,iz) ! term propto n_e^{p-2,j} Tnepm2j = xnepm2j(ip) * nadiab_moments_e(ip-pp2,ij,ikx,iky,iz) ! term propto n_e^{p,j+1} Tnepjp1 = xnepjp1(ij) * nadiab_moments_e(ip,ij+1,ikx,iky,iz) ! term propto n_e^{p,j-1} Tnepjm1 = xnepjm1(ij) * nadiab_moments_e(ip,ij-1,ikx,iky,iz) ! Parallel dynamic + Tpare = 0._dp; Tmir = 0._dp + IF(Nz .GT. 1) THEN ! ddz derivative for Landau damping term Tpare = xnepp1j(ip) * & ( onetwelfth*nadiab_moments_e(ip+1,ij,ikx,iky,izm2)& - twothird*nadiab_moments_e(ip+1,ij,ikx,iky,izm1)& + twothird*nadiab_moments_e(ip+1,ij,ikx,iky,izp1)& -onetwelfth*nadiab_moments_e(ip+1,ij,ikx,iky,izp2))& +xnepm1j(ip) * & ( onetwelfth*nadiab_moments_e(ip-1,ij,ikx,iky,izm2)& - twothird*nadiab_moments_e(ip-1,ij,ikx,iky,izm1)& + twothird*nadiab_moments_e(ip-1,ij,ikx,iky,izp1)& -onetwelfth*nadiab_moments_e(ip-1,ij,ikx,iky,izp2)) ! Mirror terms Tnepp1j = ynepp1j(ip,ij) * nadiab_moments_e(ip+1,ij ,ikx,iky,iz) Tnepp1jm1 = ynepp1jm1(ip,ij) * nadiab_moments_e(ip+1,ij-1,ikx,iky,iz) Tnepm1j = ynepm1j(ip,ij) * nadiab_moments_e(ip-1,ij ,ikx,iky,iz) Tnepm1jm1 = ynepm1jm1(ip,ij) * nadiab_moments_e(ip-1,ij-1,ikx,iky,iz) ! Trapping terms UNepm1j = zNepm1j(ip,ij) * nadiab_moments_e(ip-1,ij ,ikx,iky,iz) UNepm1jp1 = zNepm1jp1(ip,ij) * nadiab_moments_e(ip-1,ij+1,ikx,iky,iz) UNepm1jm1 = zNepm1jm1(ip,ij) * nadiab_moments_e(ip-1,ij-1,ikx,iky,iz) Tmir = Tnepp1j + Tnepp1jm1 + Tnepm1j + Tnepm1jm1 + UNepm1j + UNepm1jp1 + UNepm1jm1 - + ENDIF !! Electrical potential term IF ( p_int .LE. 2 ) THEN ! kronecker p0 p1 p2 Tphi = phi(ikx,iky,iz) * (xphij(ip,ij)*kernel_e(ij,ikx,iky,iz) & + xphijp1(ip,ij)*kernel_e(ij+1,ikx,iky,iz) & + xphijm1(ip,ij)*kernel_e(ij-1,ikx,iky,iz) ) ELSE Tphi = 0._dp ENDIF !! Collision IF (CO .EQ. 0) THEN ! Lenard Bernstein CALL LenardBernstein_e(ip,ij,ikx,iky,iz,TColl) ELSEIF (CO .EQ. 1) THEN ! GK Dougherty CALL DoughertyGK_e(ip,ij,ikx,iky,iz,TColl) ELSE ! COSOLver matrix TColl = TColl_e(ip,ij,ikx,iky,iz) ENDIF !! Sum of all linear terms (the sign is inverted to match RHS) moments_rhs_e(ip,ij,ikx,iky,iz,updatetlevel) = & ! Perpendicular magnetic gradient/curvature effects - imagu*Ckxky(ikx,iky,iz)*hatR(iz)* (Tnepj + Tnepp2j + Tnepm2j + Tnepjp1 + Tnepjm1)& ! Parallel coupling (Landau Damping) - Tpare*inv_deltaz*gradz_coeff(iz) & ! Mirror term (parallel magnetic gradient) - gradzB(iz)* Tmir *gradz_coeff(iz) & ! Drives (density + temperature gradients) - i_ky * Tphi & ! Electrostatic background gradients - i_ky * K_E * moments_e(ip,ij,ikx,iky,iz,updatetlevel) & ! Numerical hyperdiffusion (totally artificial, for stability purpose) - mu*kperp2**2 * moments_e(ip,ij,ikx,iky,iz,updatetlevel) & ! Collision term + TColl !! Adding non linearity IF ( NON_LIN ) THEN moments_rhs_e(ip,ij,ikx,iky,iz,updatetlevel) = & moments_rhs_e(ip,ij,ikx,iky,iz,updatetlevel) - Sepj(ip,ij,ikx,iky,iz) ENDIF END DO kyloope END DO kxloope END DO zloope END DO jloope END DO ploope ! Execution time end CALL cpu_time(t1_rhs) tc_rhs = tc_rhs + (t1_rhs-t0_rhs) END SUBROUTINE moments_eq_rhs_e !_____________________________________________________________________________! !_____________________________________________________________________________! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!! Ions moments RHS !!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !_____________________________________________________________________________! SUBROUTINE moments_eq_rhs_i USE basic USE time_integration, ONLY: updatetlevel USE array USE fields USE grid USE model USE prec_const USE collision IMPLICIT NONE INTEGER :: p_int, j_int ! loops indices and polynom. degrees REAL(dp) :: kx, ky, kperp2 COMPLEX(dp) :: Tnipj, Tnipp2j, Tnipm2j, Tnipjp1, Tnipjm1, Tpari, Tphi COMPLEX(dp) :: Tmir, Tnipp1j, Tnipm1j, Tnipp1jm1, Tnipm1jm1 ! Terms from mirror force with non adiab moments COMPLEX(dp) :: UNipm1j, UNipm1jp1, UNipm1jm1 ! Terms from mirror force with adiab moments COMPLEX(dp) :: TColl ! terms of the rhs COMPLEX(dp) :: i_ky REAL(dp) :: delta_p0, delta_p1, delta_p2 INTEGER :: izm2, izm1, izp1, izp2 ! indices for centered FDF ddz ! Measuring execution time CALL cpu_time(t0_rhs) ploopi : DO ip = ips_i, ipe_i ! Hermite loop p_int= parray_i(ip) ! Hermite degree delta_p0 = 0._dp; delta_p1 = 0._dp; delta_p2 = 0._dp IF(p_int .EQ. 0) delta_p0 = 1._dp IF(p_int .EQ. 1) delta_p1 = 1._dp IF(p_int .EQ. 2) delta_p2 = 1._dp jloopi : DO ij = ijs_i, ije_i ! This loop is from 1 to jmaxi+1 j_int = jarray_i(ij) ! Loop on kspace zloopi : DO iz = izs,ize ! Obtain the index with an array that accounts for boundary conditions ! e.g. : 4 stencil with periodic BC, izarray(Nz+2) = 2, izarray(-1) = Nz-1 izp1 = izarray(iz+1); izp2 = izarray(iz+2); izm1 = izarray(iz-1); izm2 = izarray(iz-2); ! kxloopi : DO ikx = ikxs,ikxe kx = kxarray(ikx) ! radial wavevector kyloopi : DO iky = ikys,ikye ky = kyarray(iky) ! toroidal wavevector i_ky = imagu * ky ! toroidal derivative IF (Nky .EQ. 1) i_ky = imagu * kxarray(ikx) ! If 1D simulation we put kx as ky ! kperp2= gxx(iz)*kx**2 + 2._dp*gxy(iz)*kx*ky + gyy(iz)*ky**2 kperp2= kparray(ikx,iky,iz)**2 !! Compute moments mixing terms ! Perpendicular dynamic ! term propto n_i^{p,j} Tnipj = xnipj(ip,ij) * nadiab_moments_i(ip,ij,ikx,iky,iz) ! term propto n_i^{p+2,j} Tnipp2j = xnipp2j(ip) * nadiab_moments_i(ip+pp2,ij,ikx,iky,iz) ! term propto n_i^{p-2,j} Tnipm2j = xnipm2j(ip) * nadiab_moments_i(ip-pp2,ij,ikx,iky,iz) ! term propto n_e^{p,j+1} Tnipjp1 = xnipjp1(ij) * nadiab_moments_i(ip,ij+1,ikx,iky,iz) ! term propto n_e^{p,j-1} Tnipjm1 = xnipjm1(ij) * nadiab_moments_i(ip,ij-1,ikx,iky,iz) ! Parallel dynamic + Tpari = 0._dp; Tmir = 0._dp + IF(Nz .GT. 1) THEN ! term propto N_i^{p,j+1}, centered FDF Tpari = xnipp1j(ip) * & ( onetwelfth*nadiab_moments_i(ip+1,ij,ikx,iky,izm2)& - twothird*nadiab_moments_i(ip+1,ij,ikx,iky,izm1)& + twothird*nadiab_moments_i(ip+1,ij,ikx,iky,izp1)& -onetwelfth*nadiab_moments_i(ip+1,ij,ikx,iky,izp2))& +xnipm1j(ip) * & ( onetwelfth*nadiab_moments_i(ip-1,ij,ikx,iky,izm2)& - twothird*nadiab_moments_i(ip-1,ij,ikx,iky,izm1)& + twothird*nadiab_moments_i(ip-1,ij,ikx,iky,izp1)& -onetwelfth*nadiab_moments_i(ip-1,ij,ikx,iky,izp2)) ! Mirror terms Tnipp1j = ynipp1j(ip,ij) * nadiab_moments_i(ip+1,ij ,ikx,iky,iz) Tnipp1jm1 = ynipp1jm1(ip,ij) * nadiab_moments_i(ip+1,ij-1,ikx,iky,iz) Tnipm1j = ynipm1j(ip,ij) * nadiab_moments_i(ip-1,ij ,ikx,iky,iz) Tnipm1jm1 = ynipm1jm1(ip,ij) * nadiab_moments_i(ip-1,ij-1,ikx,iky,iz) ! Trapping terms Unipm1j = znipm1j(ip,ij) * nadiab_moments_i(ip-1,ij ,ikx,iky,iz) Unipm1jp1 = znipm1jp1(ip,ij) * nadiab_moments_i(ip-1,ij+1,ikx,iky,iz) Unipm1jm1 = znipm1jm1(ip,ij) * nadiab_moments_i(ip-1,ij-1,ikx,iky,iz) Tmir = Tnipp1j + Tnipp1jm1 + Tnipm1j + Tnipm1jm1 + UNipm1j + UNipm1jp1 + UNipm1jm1 - + ENDIF !! Electrical potential term IF ( p_int .LE. 2 ) THEN ! kronecker p0 p1 p2 Tphi = phi(ikx,iky,iz) * (xphij(ip,ij)*kernel_i(ij,ikx,iky,iz) & + xphijp1(ip,ij)*kernel_i(ij+1,ikx,iky,iz) & + xphijm1(ip,ij)*kernel_i(ij-1,ikx,iky,iz) ) ELSE Tphi = 0._dp ENDIF !! Collision IF (CO .EQ. 0) THEN ! Lenard Bernstein CALL LenardBernstein_i(ip,ij,ikx,iky,iz,TColl) ELSEIF (CO .EQ. 1) THEN ! GK Dougherty CALL DoughertyGK_i(ip,ij,ikx,iky,iz,TColl) ELSE! COSOLver matrix (Sugama, Coulomb) TColl = TColl_i(ip,ij,ikx,iky,iz) ENDIF !! Sum of all linear terms (the sign is inverted to match RHS) moments_rhs_i(ip,ij,ikx,iky,iz,updatetlevel) = & ! Perpendicular magnetic gradient/curvature effects - imagu*Ckxky(ikx,iky,iz)*hatR(iz)*(Tnipj + Tnipp2j + Tnipm2j + Tnipjp1 + Tnipjm1)& ! Parallel coupling (Landau Damping) - Tpari*inv_deltaz*gradz_coeff(iz) & ! Mirror term (parallel magnetic gradient) - gradzB(iz)*Tmir*gradz_coeff(iz) & ! Drives (density + temperature gradients) - i_ky * Tphi & ! Electrostatic background gradients - i_ky * K_E * moments_i(ip,ij,ikx,iky,iz,updatetlevel) & ! Numerical hyperdiffusion (totally artificial, for stability purpose) - mu*kperp2**2 * moments_i(ip,ij,ikx,iky,iz,updatetlevel) & ! Collision term + TColl !! Adding non linearity IF ( NON_LIN ) THEN moments_rhs_i(ip,ij,ikx,iky,iz,updatetlevel) = & moments_rhs_i(ip,ij,ikx,iky,iz,updatetlevel) - Sipj(ip,ij,ikx,iky,iz) ENDIF END DO kyloopi END DO kxloopi END DO zloopi END DO jloopi END DO ploopi ! Execution time end CALL cpu_time(t1_rhs) tc_rhs = tc_rhs + (t1_rhs-t0_rhs) END SUBROUTINE moments_eq_rhs_i diff --git a/src/numerics_mod.F90 b/src/numerics_mod.F90 index edd297b..06235c2 100644 --- a/src/numerics_mod.F90 +++ b/src/numerics_mod.F90 @@ -1,274 +1,319 @@ MODULE numerics USE basic USE prec_const USE grid USE utility USE coeff implicit none - PUBLIC :: compute_derivatives, build_dnjs_table, evaluate_kernels, compute_lin_coeff + PUBLIC :: build_dnjs_table, evaluate_kernels, evaluate_poisson_op, compute_lin_coeff PUBLIC :: wipe_turbulence, wipe_zonalflow CONTAINS -! Compute the 2D particle temperature for electron and ions (sum over Laguerre) -SUBROUTINE compute_derivatives - -END SUBROUTINE compute_derivatives - !******************************************************************************! !!!!!!! Build the Laguerre-Laguerre coupling coefficient table for nonlin !******************************************************************************! SUBROUTINE build_dnjs_table USE array, Only : dnjs USE coeff IMPLICIT NONE INTEGER :: in, ij, is, J INTEGER :: n_, j_, s_ J = max(jmaxe,jmaxi) DO in = 1,J+1 ! Nested dependent loops to make benefit from dnjs symmetry n_ = in - 1 DO ij = in,J+1 j_ = ij - 1 DO is = ij,J+1 s_ = is - 1 dnjs(in,ij,is) = TO_DP(ALL2L(n_,j_,s_,0)) ! By symmetry dnjs(in,is,ij) = dnjs(in,ij,is) dnjs(ij,in,is) = dnjs(in,ij,is) dnjs(ij,is,in) = dnjs(in,ij,is) dnjs(is,ij,in) = dnjs(in,ij,is) dnjs(is,in,ij) = dnjs(in,ij,is) ENDDO ENDDO ENDDO END SUBROUTINE build_dnjs_table !******************************************************************************! !******************************************************************************! !!!!!!! Evaluate the kernels once for all !******************************************************************************! SUBROUTINE evaluate_kernels USE basic - USE array, Only : kernel_e, kernel_i, kparray + USE array, Only : kernel_e, kernel_i USE grid - USE model, ONLY : tau_e, tau_i, sigma_e, sigma_i, q_e, q_i, lambdaD, CLOS, sigmae2_taue_o2, sigmai2_taui_o2 + USE model, ONLY : tau_e, tau_i, sigma_e, sigma_i, q_e, q_i, & + lambdaD, CLOS, sigmae2_taue_o2, sigmai2_taui_o2, KIN_E IMPLICIT NONE INTEGER :: j_int REAL(dp) :: j_dp, y_, kp2_, kx_, ky_ DO ikx = ikxs,ikxe DO iky = ikys,ikye DO iz = izs,ize !!!!! Electron kernels !!!!! + IF(KIN_E) THEN DO ij = ijsg_e, ijeg_e j_int = jarray_e(ij) j_dp = REAL(j_int,dp) y_ = sigmae2_taue_o2 * kparray(ikx,iky,iz)**2 kernel_e(ij,ikx,iky,iz) = y_**j_int*EXP(-y_)/GAMMA(j_dp+1._dp)!factj ENDDO + ENDIF !!!!! Ion kernels !!!!! DO ij = ijsg_i, ijeg_i j_int = jarray_i(ij) j_dp = REAL(j_int,dp) y_ = sigmai2_taui_o2 * kparray(ikx,iky,iz)**2 kernel_i(ij,ikx,iky,iz) = y_**j_int*EXP(-y_)/GAMMA(j_dp+1._dp)!factj ENDDO ENDDO ENDDO ENDDO END SUBROUTINE evaluate_kernels !******************************************************************************! +!******************************************************************************! +!!!!!!! Evaluate polarisation operator for Poisson equation +!******************************************************************************! +SUBROUTINE evaluate_poisson_op + USE basic + USE array, Only : kernel_e, kernel_i, inv_poisson_op + USE grid + USE model, ONLY : tau_e, tau_i, q_e, q_i, KIN_E + IMPLICIT NONE + REAL(dp) :: pol_i, pol_e ! (Z_a^2/tau_a (1-sum_n kernel_na^2)) + INTEGER :: ini,ine + + kxloop: DO ikx = ikxs,ikxe + kyloop: DO iky = ikys,ikye + zloop: DO iz = izs,ize + IF( (kxarray(ikx).EQ.0._dp) .AND. (kyarray(iky).EQ.0._dp) ) THEN + inv_poisson_op(ikx, iky, iz) = 0._dp + ELSE + !!!!!!!!!!!!!!!!! Ion contribution + ! loop over n only if the max polynomial degree + pol_i = 0._dp + DO ini=1,jmaxi+1 + pol_i = pol_i + qi2_taui*kernel_i(ini,ikx,iky,iz)**2 ! ... sum recursively ... + END DO + !!!!!!!!!!!!! Electron contribution\ + pol_e = 0._dp + ! Kinetic model + IF (KIN_E) THEN + ! loop over n only if the max polynomial degree + DO ine=1,jmaxe+1 ! ine = n+1 + pol_e = pol_e + qe2_taue*kernel_e(ine,ikx,iky,iz)**2 ! ... sum recursively ... + END DO + ! Adiabatic model + ELSE + pol_e = 1._dp - qe2_taue + ENDIF + inv_poisson_op(ikx, iky, iz) = 1._dp/(qe2_taue + qi2_taui - pol_i - pol_e) + ENDIF + END DO zloop + END DO kyloop + END DO kxloop + +END SUBROUTINE evaluate_poisson_op +!******************************************************************************! + SUBROUTINE compute_lin_coeff USE array USE model, ONLY: taue_qe, taui_qi, sqrtTaue_qe, sqrtTaui_qi, & - K_T, K_n, CurvB, GradB + K_T, K_n, CurvB, GradB, KIN_E USE prec_const USE grid, ONLY: parray_e, parray_i, jarray_e, jarray_i, & ip,ij, ips_e,ipe_e, ips_i,ipe_i, ijs_e,ije_e, ijs_i,ije_i IMPLICIT NONE INTEGER :: p_int, j_int ! polynom. degrees REAL(dp) :: p_dp, j_dp REAL(dp) :: kx, ky, z !! Electrons linear coefficients for moment RHS !!!!!!!!!! + IF(KIN_E)THEN DO ip = ips_e, ipe_e p_int= parray_e(ip) ! Hermite degree p_dp = REAL(p_int,dp) ! REAL of Hermite degree DO ij = ijs_e, ije_e j_int= jarray_e(ij) ! Laguerre degree j_dp = REAL(j_int,dp) ! REAL of Laguerre degree ! All Napj terms xnepj(ip,ij) = taue_qe*(CurvB*(2._dp*p_dp + 1._dp) & +GradB*(2._dp*j_dp + 1._dp)) ! Mirror force terms ynepp1j (ip,ij) = -SQRT(tau_e)/sigma_e * (j_dp+1)*SQRT(p_dp+1._dp) ynepm1j (ip,ij) = -SQRT(tau_e)/sigma_e * (j_dp+1)*SQRT(p_dp) ynepp1jm1(ip,ij) = +SQRT(tau_e)/sigma_e * j_dp*SQRT(p_dp+1._dp) ynepm1jm1(ip,ij) = +SQRT(tau_e)/sigma_e * j_dp*SQRT(p_dp) zNepm1j (ip,ij) = +SQRT(tau_e)/sigma_e * (2._dp*j_dp+1_dp)*SQRT(p_dp) zNepm1jp1(ip,ij) = -SQRT(tau_e)/sigma_e * (j_dp+1_dp)*SQRT(p_dp) zNepm1jm1(ip,ij) = -SQRT(tau_e)/sigma_e * j_dp*SQRT(p_dp) ENDDO ENDDO DO ip = ips_e, ipe_e p_int= parray_e(ip) ! Hermite degree p_dp = REAL(p_int,dp) ! REAL of Hermite degree ! Landau damping coefficients (ddz napj term) xnepp1j(ip) = SQRT(tau_e)/sigma_e * SQRT(p_dp + 1_dp) xnepm1j(ip) = SQRT(tau_e)/sigma_e * SQRT(p_dp) ! Magnetic curvature term xnepp2j(ip) = taue_qe * CurvB * SQRT((p_dp + 1._dp) * (p_dp + 2._dp)) xnepm2j(ip) = taue_qe * CurvB * SQRT(p_dp * (p_dp - 1._dp)) ENDDO DO ij = ijs_e, ije_e j_int= jarray_e(ij) ! Laguerre degree j_dp = REAL(j_int,dp) ! REAL of Laguerre degree ! Magnetic gradient term xnepjp1(ij) = -taue_qe * GradB * (j_dp + 1._dp) xnepjm1(ij) = -taue_qe * GradB * j_dp ENDDO + ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Ions linear coefficients for moment RHS !!!!!!!!!! DO ip = ips_i, ipe_i p_int= parray_i(ip) ! Hermite degree p_dp = REAL(p_int,dp) ! REAL of Hermite degree DO ij = ijs_i, ije_i j_int= jarray_i(ij) ! Laguerre degree j_dp = REAL(j_int,dp) ! REAL of Laguerre degree ! All Napj terms xnipj(ip,ij) = taui_qi*(CurvB*(2._dp*p_dp + 1._dp) & +GradB*(2._dp*j_dp + 1._dp)) ! Mirror force terms ynipp1j (ip,ij) = -SQRT(tau_i)/sigma_i* (j_dp+1)*SQRT(p_dp+1._dp) ynipm1j (ip,ij) = -SQRT(tau_i)/sigma_i* (j_dp+1)*SQRT(p_dp) ynipp1jm1(ip,ij) = +SQRT(tau_i)/sigma_i* j_dp*SQRT(p_dp+1._dp) ynipm1jm1(ip,ij) = +SQRT(tau_i)/sigma_i* j_dp*SQRT(p_dp) ! Trapping terms zNipm1j (ip,ij) = +SQRT(tau_i)/sigma_i* (2._dp*j_dp+1_dp)*SQRT(p_dp) zNipm1jp1(ip,ij) = -SQRT(tau_i)/sigma_i* (j_dp+1_dp)*SQRT(p_dp) zNipm1jm1(ip,ij) = -SQRT(tau_i)/sigma_i* j_dp*SQRT(p_dp) ENDDO ENDDO DO ip = ips_i, ipe_i p_int= parray_i(ip) ! Hermite degree p_dp = REAL(p_int,dp) ! REAL of Hermite degree ! Landau damping coefficients (ddz napj term) xnipp1j(ip) = SQRT(tau_i)/sigma_i * SQRT(p_dp + 1._dp) xnipm1j(ip) = SQRT(tau_i)/sigma_i * SQRT(p_dp) ! Magnetic curvature term xnipp2j(ip) = taui_qi * CurvB * SQRT((p_dp + 1._dp) * (p_dp + 2._dp)) xnipm2j(ip) = taui_qi * CurvB * SQRT(p_dp * (p_dp - 1._dp)) ENDDO DO ij = ijs_i, ije_i j_int= jarray_i(ij) ! Laguerre degree j_dp = REAL(j_int,dp) ! REAL of Laguerre degree ! Magnetic gradient term xnipjp1(ij) = -taui_qi * GradB * (j_dp + 1._dp) xnipjm1(ij) = -taui_qi * GradB * j_dp ENDDO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ES linear coefficients for moment RHS !!!!!!!!!! DO ip = ips_i, ipe_i p_int= parray_i(ip) ! Hermite degree DO ij = ijs_i, ije_i j_int= jarray_i(ij) ! REALof Laguerre degree j_dp = REAL(j_int,dp) ! REALof Laguerre degree !! Electrostatic potential pj terms IF (p_int .EQ. 0) THEN ! kronecker p0 xphij(ip,ij) =+K_n + 2.*j_dp*K_T xphijp1(ip,ij) =-K_T*(j_dp+1._dp) xphijm1(ip,ij) =-K_T* j_dp ELSE IF (p_int .EQ. 2) THEN ! kronecker p2 xphij(ip,ij) =+K_T/SQRT2 xphijp1(ip,ij) = 0._dp; xphijm1(ip,ij) = 0._dp; ELSE xphij(ip,ij) = 0._dp; xphijp1(ip,ij) = 0._dp xphijm1(ip,ij) = 0._dp; ENDIF ENDDO ENDDO END SUBROUTINE compute_lin_coeff !******************************************************************************! !!!!!!! Remove all ky!=0 modes to conserve only zonal modes in a restart !******************************************************************************! SUBROUTINE wipe_turbulence USE fields USE grid IMPLICIT NONE DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e IF( iky .NE. iky_0) THEN moments_e( ip,ij,ikx,iky,iz, :) = 0e-3_dp*moments_e( ip,ij,ikx,iky,iz, :) ELSE moments_e( ip,ij,ikx,iky,iz, :) = 1e+0_dp*moments_e( ip,ij,ikx,iky,iz, :) ENDIF ENDDO ENDDO DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i IF( iky .NE. iky_0) THEN moments_i( ip,ij,ikx,iky,iz, :) = 0e-3_dp*moments_i( ip,ij,ikx,iky,iz, :) ELSE moments_i( ip,ij,ikx,iky,iz, :) = 1e+0_dp*moments_i( ip,ij,ikx,iky,iz, :) ENDIF ENDDO ENDDO IF( iky .NE. iky_0) THEN phi(ikx,iky,iz) = 0e-3_dp*phi(ikx,iky,iz) ELSE phi(ikx,iky,iz) = 1e+0_dp*phi(ikx,iky,iz) ENDIF ENDDO ENDDO ENDDO END SUBROUTINE !******************************************************************************! !!!!!!! Remove all ky==0 modes to conserve only non zonal modes in a restart !******************************************************************************! SUBROUTINE wipe_zonalflow USE fields USE grid IMPLICIT NONE DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e IF( iky .EQ. iky_0) THEN moments_e( ip,ij,ikx,iky,iz, :) = 0e-3_dp*moments_e( ip,ij,ikx,iky,iz, :) ELSE moments_e( ip,ij,ikx,iky,iz, :) = 1e+0_dp*moments_e( ip,ij,ikx,iky,iz, :) ENDIF ENDDO ENDDO DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i IF( iky .EQ. iky_0) THEN moments_i( ip,ij,ikx,iky,iz, :) = 0e-3_dp*moments_i( ip,ij,ikx,iky,iz, :) ELSE moments_i( ip,ij,ikx,iky,iz, :) = 1e+0_dp*moments_i( ip,ij,ikx,iky,iz, :) ENDIF ENDDO ENDDO IF( iky .EQ. iky_0) THEN phi(ikx,iky,iz) = 0e-3_dp*phi(ikx,iky,iz) ELSE phi(ikx,iky,iz) = 1e+0_dp*phi(ikx,iky,iz) ENDIF ENDDO ENDDO ENDDO END SUBROUTINE END MODULE numerics diff --git a/src/poisson.F90 b/src/poisson.F90 index 486dc0c..8cc242c 100644 --- a/src/poisson.F90 +++ b/src/poisson.F90 @@ -1,71 +1,75 @@ SUBROUTINE poisson ! Solve poisson equation to get phi USE basic USE time_integration, ONLY: updatetlevel USE array USE fields USE grid USE utility - use model, ONLY : qe2_taue, qi2_taui, q_e, q_i, lambdaD - + use model, ONLY : qe2_taue, qi2_taui, q_e, q_i, lambdaD, KIN_E + USE processing, ONLY : compute_density USE prec_const + USE geometry, ONLY : iInt_Jacobian, Jacobian IMPLICIT NONE INTEGER :: ini,ine, i_, root_bcast - REAL(dp) :: Kne, Kni ! sub kernel factor for recursive build - REAL(dp) :: polarisation ! sum_a(Z_a^2/tau_a (1-sum_n kernel_na^2)) - COMPLEX(dp) :: q_density ! charge density sum_a q_a n_a - REAL(dp) :: gammaD - COMPLEX(dp) :: gammaD_phi + COMPLEX(dp) :: fa_phi, intf_ ! current flux averaged phi INTEGER :: count !! mpi integer to broadcast the electric potential at the end COMPLEX(dp) :: buffer(ikxs:ikxe,ikys:ikye) + COMPLEX(dp), DIMENSION(izs:ize) :: rho_i, rho_e ! charge density q_a n_a + COMPLEX(dp), DIMENSION(izs:ize) :: integrant ! charge density q_a n_a !! Poisson can be solved only for process containing ip=1 IF ( (ips_e .EQ. ip0_e) .AND. (ips_i .EQ. ip0_i) ) THEN - ! Execution time start CALL cpu_time(t0_poisson) kxloop: DO ikx = ikxs,ikxe kyloop: DO iky = ikys,ikye - zloop: DO iz = izs,ize + !!!! Compute ion gyro charge density + rho_i = 0._dp + DO ini=1,jmaxi+1 + rho_i = rho_i & + +q_i*kernel_i(ini,ikx,iky,:)*moments_i(ip0_i,ini,ikx,iky,:,updatetlevel) + END DO - q_density = 0._dp - polarisation = 0._dp - !!!!!!!!!!!!! Electron contribution - ! loop over n only if the max polynomial degree - DO ine=1,jmaxe+1 ! ine = n+1 - Kne = kernel_e(ine,ikx,iky,iz) - q_density = q_density + q_e*Kne*moments_e(ip0_e, ine, ikx, iky, iz, updatetlevel) - polarisation = polarisation + qe2_taue*Kne**2 ! ... sum recursively ... + !!!! Compute electron gyro charge density + rho_e = 0._dp + IF (KIN_E) THEN ! Kinetic electrons + DO ine=1,jmaxe+1 + rho_e = rho_e & + +q_e*kernel_e(ine,ikx,iky,:)*moments_e(ip0_e,ine, ikx,iky,:,updatetlevel) END DO + ELSE ! Adiabatic electrons + ! Adiabatic charge density (linked to flux averaged phi) + fa_phi = 0._dp + IF(kyarray(iky).EQ.0._dp) THEN + DO ini=1,jmaxi+1 + rho_e(:) = Jacobian(:)*moments_i(ip0_i,ini,ikx,iky,:,updatetlevel)& + *kernel_i(ini,ikx,iky,:)*(inv_poisson_op(ikx,iky,:)-1._dp) + call simpson_rule_z(rho_e,intf_) + fa_phi = fa_phi + intf_ + ENDDO + rho_e = fa_phi*iInt_Jacobian !Normalize by 1/int(Jxyz)dz + ENDIF + ENDIF - !!!!!!!!!!!!!!!!! Ions contribution - ! loop over n only if the max polynomial degree - DO ini=1,jmaxi+1 - Kni = kernel_i(ini,ikx,iky,iz) - q_density = q_density + q_i*Kni*moments_i(ip0_i, ini, ikx, iky, iz, updatetlevel) - polarisation = polarisation + qi2_taui*Kni**2 ! ... sum recursively ... - END DO - - !!!!!!!!!!!!!!! Assembling the poisson equation !!!!!!!!!!!!!!!!!!!!!!!!!! - phi(ikx, iky, iz) = q_density/(qe2_taue + qi2_taui - polarisation) - - END DO zloop + !!!!!!!!!!!!!!! Inverting the poisson equation !!!!!!!!!!!!!!!!!!!!!!!!!! + phi(ikx, iky, :) = (rho_e + rho_i)*inv_poisson_op(ikx,iky,:) END DO kyloop END DO kxloop ! Cancel origin singularity - IF (contains_kx0 .AND. contains_ky0) phi(ikx_0,iky_0,izs:ize) = 0._dp + IF (contains_kx0 .AND. contains_ky0) phi(ikx_0,iky_0,:) = 0._dp ENDIF ! Transfer phi to all the others process along p CALL manual_3D_bcast(phi(ikxs:ikxe,ikys:ikye,izs:ize)) ! Execution time end CALL cpu_time(t1_poisson) tc_poisson = tc_poisson + (t1_poisson - t0_poisson) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END SUBROUTINE poisson diff --git a/src/processing_mod.F90 b/src/processing_mod.F90 index 768cc94..2866a44 100644 --- a/src/processing_mod.F90 +++ b/src/processing_mod.F90 @@ -1,244 +1,253 @@ MODULE processing ! contains the Hermite-Laguerre collision operators. Solved using COSOlver. USE basic USE prec_const USE grid USE utility implicit none REAL(dp), PUBLIC, PROTECTED :: pflux_ri, gflux_ri REAL(dp), PUBLIC, PROTECTED :: hflux_x PUBLIC :: compute_density, compute_temperature, compute_nadiab_moments PUBLIC :: compute_radial_ion_transport, compute_radial_heatflux CONTAINS ! 1D diagnostic to compute the average radial particle transport _r SUBROUTINE compute_radial_ion_transport USE fields, ONLY : moments_i, phi USE array, ONLY : kernel_i USE time_integration, ONLY : updatetlevel IMPLICIT NONE COMPLEX(dp) :: pflux_local, gflux_local REAL(dp) :: ky_, buffer(1:2) INTEGER :: i_, world_rank, world_size, root pflux_local = 0._dp ! particle flux gflux_local = 0._dp ! gyrocenter flux IF(ips_i .EQ. 1) THEN ! Loop to compute gamma_kx = sum_ky sum_j -i k_z Kernel_j Ni00 * phi DO iz = izs,ize DO iky = ikys,ikye ky_ = kyarray(iky) DO ikx = ikxs,ikxe gflux_local = gflux_local + & imagu * ky_ * moments_i(ip0_i,1,ikx,iky,iz,updatetlevel) * CONJG(phi(ikx,iky,iz)) DO ij = ijs_i, ije_i pflux_local = pflux_local + & imagu * ky_ * kernel_i(ij,ikx,iky,iz) * moments_i(ip0_i,ij,ikx,iky,iz,updatetlevel) * CONJG(phi(ikx,iky,iz)) ENDDO ENDDO ENDDO ENDDO gflux_local = gflux_local/Nz ! Average over parallel planes pflux_local = pflux_local/Nz buffer(1) = REAL(gflux_local) buffer(2) = REAL(pflux_local) root = 0 !Gather manually among the rank_p=0 processes and perform the sum gflux_ri = 0 pflux_ri = 0 IF (num_procs_kx .GT. 1) THEN !! Everyone sends its local_sum to root = 0 IF (rank_kx .NE. root) THEN CALL MPI_SEND(buffer, 2 , MPI_DOUBLE_PRECISION, root, 1234, comm_kx, ierr) ELSE ! Recieve from all the other processes DO i_ = 0,num_procs_kx-1 IF (i_ .NE. rank_kx) & CALL MPI_RECV(buffer, 2 , MPI_DOUBLE_PRECISION, i_, 1234, comm_kx, MPI_STATUS_IGNORE, ierr) gflux_ri = gflux_ri + buffer(1) pflux_ri = pflux_ri + buffer(2) ENDDO ENDIF ENDIF ENDIF END SUBROUTINE compute_radial_ion_transport ! 1D diagnostic to compute the average radial particle transport _r SUBROUTINE compute_radial_heatflux USE fields, ONLY : moments_i, moments_e, phi USE array, ONLY : dens_e, dens_i, kernel_e, kernel_i USE time_integration, ONLY : updatetlevel - USE model, ONLY : q_e, q_i, tau_e, tau_i + USE model, ONLY : q_e, q_i, tau_e, tau_i, KIN_E IMPLICIT NONE COMPLEX(dp) :: hflux_local REAL(dp) :: ky_, buffer(1:2), j_dp INTEGER :: i_, world_rank, world_size, root hflux_local = 0._dp ! particle flux IF(ips_i .EQ. 1 .AND. ips_e .EQ. 1) THEN ! Loop to compute gamma_kx = sum_ky sum_j -i k_z Kernel_j Ni00 * phi DO iz = izs,ize DO iky = ikys,ikye ky_ = kyarray(iky) DO ikx = ikxs,ikxe DO ij = ijs_i, ije_i j_dp = REAL(ij-1,dp) hflux_local = hflux_local - imagu*ky_*CONJG(phi(ikx,iky,iz))& *(2._dp/3._dp * (2._dp*j_dp*kernel_i(ij,ikx,iky,iz) - (j_dp+1)*kernel_i(ij+1,ikx,iky,iz) - j_dp*kernel_i(ij-1,ikx,iky,iz))& * (moments_i(ip0_i,ij,ikx,iky,iz,updatetlevel)+q_i/tau_i*kernel_i(ij,ikx,iky,iz)*phi(ikx,iky,iz)) & + SQRT2/3._dp * kernel_i(ij,ikx,iky,iz) * moments_i(ip2_i,ij,ikx,iky,iz,updatetlevel)) ENDDO + IF(KIN_E) THEN DO ij = ijs_e, ije_e j_dp = REAL(ij-1,dp) hflux_local = hflux_local - imagu*ky_*CONJG(phi(ikx,iky,iz))& *(2._dp/3._dp *(2._dp*j_dp * kernel_e( ij,ikx,iky,iz) & -(j_dp+1) * kernel_e(ij+1,ikx,iky,iz) & -j_dp * kernel_e(ij-1,ikx,iky,iz))& *(moments_e(ip0_e,ij,ikx,iky,iz,updatetlevel)& +q_e/tau_e * kernel_e( ij,ikx,iky,iz) * phi(ikx,iky,iz)) & +SQRT2/3._dp * kernel_e(ij,ikx,iky,iz) * moments_e(ip2_e,ij,ikx,iky,iz,updatetlevel)) ENDDO + ENDIF ENDDO ENDDO ENDDO hflux_local = hflux_local/Nz buffer(2) = REAL(hflux_local) root = 0 !Gather manually among the rank_p=0 processes and perform the sum hflux_x = 0 IF (num_procs_kx .GT. 1) THEN !! Everyone sends its local_sum to root = 0 IF (rank_kx .NE. root) THEN CALL MPI_SEND(buffer, 2 , MPI_DOUBLE_PRECISION, root, 1234, comm_kx, ierr) ELSE ! Recieve from all the other processes DO i_ = 0,num_procs_kx-1 IF (i_ .NE. rank_kx) & CALL MPI_RECV(buffer, 2 , MPI_DOUBLE_PRECISION, i_, 1234, comm_kx, MPI_STATUS_IGNORE, ierr) hflux_x = hflux_x + buffer(2) ENDDO ENDIF ENDIF ENDIF END SUBROUTINE compute_radial_heatflux SUBROUTINE compute_nadiab_moments ! evaluate the non-adiabatique ion moments ! ! n_{pi} = N^{pj} + kernel(j) /tau_i phi delta_p0 ! USE fields, ONLY : moments_i, moments_e, phi USE array, ONLY : kernel_e, kernel_i, nadiab_moments_e, nadiab_moments_i USE time_integration, ONLY : updatetlevel - USE model, ONLY : qe_taue, qi_taui + USE model, ONLY : qe_taue, qi_taui, KIN_E implicit none ! Add non-adiabatique term + IF(KIN_E) THEN DO ip=ipsg_e,ipeg_e IF(parray_e(ip) .EQ. 0) THEN DO ij=ijsg_e,ijeg_e nadiab_moments_e(ip,ij,ikxs:ikxe,ikys:ikye,izs:ize)& = moments_e(ip,ij,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) & + qe_taue*kernel_e(ij,ikxs:ikxe,ikys:ikye,izs:ize)*phi(ikxs:ikxe,ikys:ikye,izs:ize) ENDDO ELSE nadiab_moments_e(ip,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize) & = moments_e(ip,ijsg_e:ijeg_e,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) ENDIF ENDDO + ENDIF ! Add non-adiabatique term DO ip=ipsg_i,ipeg_i IF(parray_i(ip) .EQ. 0) THEN DO ij=ijsg_i,ijeg_i nadiab_moments_i(ip,ij,ikxs:ikxe,ikys:ikye,izs:ize)& = moments_i(ip,ij,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) & + qi_taui*kernel_i(ij,ikxs:ikxe,ikys:ikye,izs:ize)*phi(ikxs:ikxe,ikys:ikye,izs:ize) ENDDO ELSE nadiab_moments_i(ip,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize) & = moments_i(ip,ijsg_i:ijeg_i,ikxs:ikxe,ikys:ikye,izs:ize,updatetlevel) ENDIF ENDDO ! END SUBROUTINE compute_nadiab_moments ! Compute the 2D particle density for electron and ions (sum over Laguerre) SUBROUTINE compute_density USE fields, ONLY : moments_i, moments_e, phi USE array, ONLY : dens_e, dens_i, kernel_e, kernel_i USE time_integration, ONLY : updatetlevel - USE model, ONLY : q_e, q_i, tau_e, tau_i + USE model, ONLY : q_e, q_i, tau_e, tau_i, KIN_E IMPLICIT NONE - IF( (ips_i .EQ. 1) .AND. (ips_e .EQ. 1) ) THEN + IF ( (ips_e .EQ. ip0_e) .AND. (ips_i .EQ. ip0_i) ) THEN ! Loop to compute dens_i = sum_j kernel_j Ni0j at each k DO iky = ikys,ikye DO ikx = ikxs,ikxe DO iz = izs,ize + IF(KIN_E) THEN ! electron density dens_e(ikx,iky,iz) = 0._dp DO ij = ijs_e, ije_e dens_e(ikx,iky,iz) = dens_e(ikx,iky,iz) + kernel_e(ij,ikx,iky,iz) * & (moments_e(ip0_e,ij,ikx,iky,iz,updatetlevel)+q_e/tau_e*kernel_e(ij,ikx,iky,iz)*phi(ikx,iky,iz)) ENDDO + ENDIF ! ion density dens_i(ikx,iky,iz) = 0._dp DO ij = ijs_i, ije_i dens_i(ikx,iky,iz) = dens_i(ikx,iky,iz) + kernel_i(ij,ikx,iky,iz) * & (moments_i(ip0_i,ij,ikx,iky,iz,updatetlevel)+q_i/tau_i*kernel_i(ij,ikx,iky,iz)*phi(ikx,iky,iz)) ENDDO ENDDO ENDDO ENDDO ENDIF + IF(KIN_E)& CALL manual_3D_bcast(dens_e(ikxs:ikxe,ikys:ikye,izs:ize)) CALL manual_3D_bcast(dens_i(ikxs:ikxe,ikys:ikye,izs:ize)) END SUBROUTINE compute_density ! Compute the 2D particle temperature for electron and ions (sum over Laguerre) SUBROUTINE compute_temperature USE fields, ONLY : moments_i, moments_e, phi USE array, ONLY : temp_e, temp_i, kernel_e, kernel_i USE time_integration, ONLY : updatetlevel - USE model, ONLY : q_e, q_i, tau_e, tau_i + USE model, ONLY : q_e, q_i, tau_e, tau_i, KIN_E IMPLICIT NONE REAL(dp) :: j_dp COMPLEX(dp) :: Tperp, Tpar IF( ((ips_i .EQ. 1) .AND. (ips_e .EQ. 1)) ) THEN ! Loop to compute T = 1/3*(Tpar + 2Tperp) DO iky = ikys,ikye DO ikx = ikxs,ikxe DO iz = izs,ize ! electron temperature + IF(KIN_E) THEN temp_e(ikx,iky,iz) = 0._dp DO ij = ijs_e, ije_e j_dp = REAL(ij-1,dp) temp_e(ikx,iky,iz) = temp_e(ikx,iky,iz) + & 2._dp/3._dp * (2._dp*j_dp*kernel_e(ij,ikx,iky,iz) - (j_dp+1)*kernel_e(ij+1,ikx,iky,iz) - j_dp*kernel_e(ij-1,ikx,iky,iz))& * (moments_e(ip0_e,ij,ikx,iky,iz,updatetlevel)+q_e/tau_e*kernel_e(ij,ikx,iky,iz)*phi(ikx,iky,iz)) & + SQRT2/3._dp * kernel_e(ij,ikx,iky,iz) * moments_e(ip2_e,ij,ikx,iky,iz,updatetlevel) ENDDO - + ENDIF ! ion temperature temp_i(ikx,iky,iz) = 0._dp DO ij = ijs_i, ije_i j_dp = REAL(ij-1,dp) temp_i(ikx,iky,iz) = temp_i(ikx,iky,iz) + & 2._dp/3._dp * (2._dp*j_dp*kernel_i(ij,ikx,iky,iz) - (j_dp+1)*kernel_i(ij+1,ikx,iky,iz) - j_dp*kernel_i(ij-1,ikx,iky,iz))& * (moments_i(ip0_i,ij,ikx,iky,iz,updatetlevel)+q_i/tau_i*kernel_i(ij,ikx,iky,iz)*phi(ikx,iky,iz)) & + SQRT2/3._dp * kernel_i(ij,ikx,iky,iz) * moments_i(ip2_i,ij,ikx,iky,iz,updatetlevel) ENDDO ENDDO ENDDO ENDDO ENDIF + IF(KIN_E)& CALL manual_3D_bcast(temp_e(ikxs:ikxe,ikys:ikye,izs:ize)) CALL manual_3D_bcast(temp_i(ikxs:ikxe,ikys:ikye,izs:ize)) END SUBROUTINE compute_temperature END MODULE processing diff --git a/src/srcinfo.h b/src/srcinfo.h index be0f13e..85bcb0f 100644 --- a/src/srcinfo.h +++ b/src/srcinfo.h @@ -1,10 +1,10 @@ character(len=40) VERSION character(len=40) BRANCH character(len=20) AUTHOR character(len=40) EXECDATE character(len=40) HOST -parameter (VERSION='59f9a2d-dirty') +parameter (VERSION='d29af00-dirty') parameter (BRANCH='master') parameter (AUTHOR='ahoffman') -parameter (EXECDATE='Wed Oct 27 15:24:35 CEST 2021') +parameter (EXECDATE='Fri Oct 29 18:03:02 CEST 2021') parameter (HOST ='spcpc606') diff --git a/src/srcinfo/srcinfo.h b/src/srcinfo/srcinfo.h index be0f13e..85bcb0f 100644 --- a/src/srcinfo/srcinfo.h +++ b/src/srcinfo/srcinfo.h @@ -1,10 +1,10 @@ character(len=40) VERSION character(len=40) BRANCH character(len=20) AUTHOR character(len=40) EXECDATE character(len=40) HOST -parameter (VERSION='59f9a2d-dirty') +parameter (VERSION='d29af00-dirty') parameter (BRANCH='master') parameter (AUTHOR='ahoffman') -parameter (EXECDATE='Wed Oct 27 15:24:35 CEST 2021') +parameter (EXECDATE='Fri Oct 29 18:03:02 CEST 2021') parameter (HOST ='spcpc606') diff --git a/src/stepon.F90 b/src/stepon.F90 index 26b3df8..a5b65bb 100644 --- a/src/stepon.F90 +++ b/src/stepon.F90 @@ -1,150 +1,156 @@ SUBROUTINE stepon ! Advance one time step, (num_step=4 for Runge Kutta 4 scheme) USE advance_field_routine, ONLY: advance_time_level, advance_field, advance_moments USE array , ONLY: moments_rhs_e, moments_rhs_i, Sepj, Sipj USE basic USE closure USE collision, ONLY : compute_TColl USE fields, ONLY: moments_e, moments_i, phi USE initial_par, ONLY: WIPE_ZF, WIPE_TURB USE ghosts USE grid - USE model + USE model, ONLY : NON_LIN, KIN_E use prec_const USE time_integration USE numerics, ONLY: wipe_zonalflow, wipe_turbulence USE processing, ONLY: compute_nadiab_moments USE utility, ONLY: checkfield IMPLICIT NONE INTEGER :: num_step LOGICAL :: mlend DO num_step=1,ntimelevel ! eg RK4 compute successively k1, k2, k3, k4 !----- BEFORE: All fields are updated for step = n ! Compute right hand side from current fields ! N_rhs(N_n, nadia_n, phi_n, S_n, Tcoll_n) - CALL moments_eq_rhs_e + IF(KIN_E) CALL moments_eq_rhs_e CALL moments_eq_rhs_i ! ---- step n -> n+1 transition ! Advance from updatetlevel to updatetlevel+1 (according to num. scheme) CALL advance_time_level ! Update moments with the hierarchy RHS (step by step) ! N_n+1 = N_n + N_rhs(n) CALL advance_moments ! Closure enforcement of N_n+1 CALL apply_closure_model ! Exchanges the ghosts values of N_n+1 CALL update_ghosts ! Update collision C_n+1 = C(N_n+1) CALL compute_TColl ! Update electrostatic potential phi_n = phi(N_n+1) CALL poisson ! Update non adiabatic moments n -> n+1 CALL compute_nadiab_moments ! Update nonlinear term S_n -> S_n+1(phi_n+1,N_n+1) IF ( NON_LIN ) CALL compute_Sapj ! Cancel zonal modes artificially IF ( WIPE_ZF .EQ. 2) CALL wipe_zonalflow ! Cancel non zonal modes artificially IF ( WIPE_TURB .EQ. 2) CALL wipe_turbulence !- Check before next step CALL checkfield_all() IF( nlend ) EXIT ! exit do loop CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) !----- AFTER: All fields are updated for step = n+1 END DO CONTAINS SUBROUTINE checkfield_all ! Check all the fields for inf or nan ! Execution time start CALL cpu_time(t0_checkfield) IF(NON_LIN) CALL anti_aliasing ! ensure 0 mode for 2/3 rule IF(NON_LIN) CALL enforce_symmetry ! Enforcing symmetry on kx = 0 mlend=.FALSE. IF(.NOT.nlend) THEN mlend=mlend .or. checkfield(phi,' phi') + IF(KIN_E) THEN DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e mlend=mlend .or. checkfield(moments_e(ip,ij,:,:,:,updatetlevel),' moments_e') ENDDO ENDDO + ENDIF DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i mlend=mlend .or. checkfield(moments_i(ip,ij,:,:,:,updatetlevel),' moments_i') ENDDO ENDDO CALL MPI_ALLREDUCE(mlend, nlend, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) ENDIF ! Execution time end CALL cpu_time(t1_checkfield) tc_checkfield = tc_checkfield + (t1_checkfield - t0_checkfield) END SUBROUTINE checkfield_all SUBROUTINE anti_aliasing + IF(KIN_E)THEN DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize moments_e( ip,ij,ikx,iky,iz,:) = AA_x(ikx)* AA_y(iky) * moments_e( ip,ij,ikx,iky,iz,:) END DO END DO END DO END DO END DO + ENDIF DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i DO ikx=ikxs,ikxe DO iky=ikys,ikye DO iz=izs,ize moments_i( ip,ij,ikx,iky,iz,:) = AA_x(ikx)* AA_y(iky) * moments_i( ip,ij,ikx,iky,iz,:) END DO END DO END DO END DO END DO END SUBROUTINE anti_aliasing SUBROUTINE enforce_symmetry ! Force X(k) = X(N-k)* complex conjugate symmetry IF ( contains_kx0 ) THEN ! Electron moments + IF(KIN_E) THEN DO ip=ips_e,ipe_e DO ij=ijs_e,ije_e DO iz=izs,ize DO iky=2,Nky/2 !symmetry at kx = 0 moments_e( ip,ij,ikx_0,iky,iz, :) = CONJG(moments_e( ip,ij,ikx_0,Nky+2-iky,iz, :)) END DO ! must be real at origin moments_e(ip,ij, ikx_0,iky_0,iz, :) = REAL(moments_e(ip,ij, ikx_0,iky_0,iz, :)) END DO END DO END DO + ENDIF ! Ion moments DO ip=ips_i,ipe_i DO ij=ijs_i,ije_i DO iz=izs,ize DO iky=2,Nky/2 !symmetry at kx = 0 moments_i( ip,ij,ikx_0,iky,iz, :) = CONJG(moments_i( ip,ij,ikx_0,Nky+2-iky,iz, :)) END DO ! must be real at origin and top right moments_i(ip,ij, ikx_0,iky_0,iz, :) = REAL(moments_i(ip,ij, ikx_0,iky_0,iz, :)) END DO END DO END DO ! Phi DO iky=2,Nky/2 !symmetry at kx = 0 phi(ikx_0,iky,:) = phi(ikx_0,Nky+2-iky,:) END DO ! must be real at origin phi(ikx_0,iky_0,:) = REAL(phi(ikx_0,iky_0,:)) ENDIF END SUBROUTINE enforce_symmetry END SUBROUTINE stepon diff --git a/src/utility_mod.F90 b/src/utility_mod.F90 index a295575..556ed5c 100644 --- a/src/utility_mod.F90 +++ b/src/utility_mod.F90 @@ -1,152 +1,223 @@ MODULE utility USE basic use prec_const IMPLICIT NONE - PUBLIC :: manual_2D_bcast, manual_3D_bcast + PUBLIC :: manual_2D_bcast, manual_3D_bcast,& + simpson_rule_z, o2e_z, e2o_z CONTAINS FUNCTION is_nan(x,str) RESULT(isn) USE time_integration use prec_const IMPLICIT NONE real(dp), INTENT(IN) :: x CHARACTER(LEN=*), INTENT(IN) :: str LOGICAL :: isn isn=.FALSE. IF(x .NE. x) THEN isn=.TRUE. END IF IF((isn).AND.(str.NE.'')) THEN WRITE(*,'(a20,a25,i6.6,a20,i1)') str,' = NaN at timestep',cstep, ' and substep',updatetlevel CALL FLUSH(stdout) END IF END FUNCTION is_nan FUNCTION is_inf(x,str) RESULT(isi) USE time_integration use prec_const IMPLICIT NONE real(dp), INTENT(IN) :: x CHARACTER(LEN=*), INTENT(IN) :: str LOGICAL :: isi isi=.FALSE. IF(x+1.0== x) THEN isi=.TRUE. END IF IF((isi).AND.(str.NE.'')) THEN !WRITE(*,'(a20,a25,i6.6,a20,i1)') str,' = Inf at timestep',cstep, ' and substep',updatetlevel CALL FLUSH(stdout) END IF END FUNCTION is_inf FUNCTION checkfield(field,str) RESULT(mlend) USE grid use prec_const IMPLICIT NONE COMPLEX(dp), DIMENSION(ikxs:ikxe,ikys:ikye), INTENT(IN) :: field CHARACTER(LEN=*), INTENT(IN) :: str LOGICAL :: mlend COMPLEX(dp) :: sumfield sumfield=SUM(field) mlend= is_nan( REAL(sumfield),str).OR.is_inf( REAL(sumfield),str) & .OR. is_nan(AIMAG(sumfield),str).OR.is_inf(AIMAG(sumfield),str) END FUNCTION checkfield !!!!! This is a manual way to do MPI_BCAST !!!!!!!!!!! SUBROUTINE manual_2D_bcast(field_) USE grid IMPLICIT NONE COMPLEX(dp), INTENT(INOUT) :: field_(ikxs:ikxe,ikys:ikye) COMPLEX(dp) :: buffer(ikxs:ikxe,ikys:ikye) INTEGER :: i_, root, world_rank, world_size root = 0; CALL MPI_COMM_RANK(comm_p,world_rank,ierr) CALL MPI_COMM_SIZE(comm_p,world_size,ierr) IF (world_size .GT. 1) THEN !! Broadcast phi to the other processes on the same k range (communicator along p) IF (world_rank .EQ. root) THEN ! Fill the buffer DO ikx = ikxs,ikxe DO iky = ikys,ikye buffer(ikx,iky) = field_(ikx,iky) ENDDO ENDDO ! Send it to all the other processes DO i_ = 0,num_procs_p-1 IF (i_ .NE. world_rank) & CALL MPI_SEND(buffer, local_nkx * Nky , MPI_DOUBLE_COMPLEX, i_, 0, comm_p, ierr) ENDDO ELSE ! Recieve buffer from root CALL MPI_RECV(buffer, local_nkx * Nky , MPI_DOUBLE_COMPLEX, root, 0, comm_p, MPI_STATUS_IGNORE, ierr) ! Write it in phi DO ikx = ikxs,ikxe DO iky = ikys,ikye field_(ikx,iky) = buffer(ikx,iky) ENDDO ENDDO ENDIF ENDIF END SUBROUTINE manual_2D_bcast !!!!! This is a manual way to do MPI_BCAST !!!!!!!!!!! SUBROUTINE manual_3D_bcast(field_) USE grid IMPLICIT NONE COMPLEX(dp), INTENT(INOUT) :: field_(ikxs:ikxe,ikys:ikye,izs:ize) COMPLEX(dp) :: buffer(ikxs:ikxe,ikys:ikye,izs:ize) INTEGER :: i_, root, world_rank, world_size root = 0; CALL MPI_COMM_RANK(comm_p,world_rank,ierr) CALL MPI_COMM_SIZE(comm_p,world_size,ierr) IF (world_size .GT. 1) THEN !! Broadcast phi to the other processes on the same k range (communicator along p) IF (world_rank .EQ. root) THEN ! Fill the buffer DO ikx = ikxs,ikxe DO iky = ikys,ikye DO iz = izs,ize buffer(ikx,iky,iz) = field_(ikx,iky,iz) ENDDO ENDDO ENDDO ! Send it to all the other processes DO i_ = 0,num_procs_p-1 IF (i_ .NE. world_rank) & CALL MPI_SEND(buffer, local_nkx * Nky * Nz, MPI_DOUBLE_COMPLEX, i_, 0, comm_p, ierr) ENDDO ELSE ! Recieve buffer from root CALL MPI_RECV(buffer, local_nkx * Nky * Nz, MPI_DOUBLE_COMPLEX, root, 0, comm_p, MPI_STATUS_IGNORE, ierr) ! Write it in phi DO ikx = ikxs,ikxe DO iky = ikys,ikye DO iz = izs,ize field_(ikx,iky,iz) = buffer(ikx,iky,iz) ENDDO ENDDO ENDDO ENDIF ENDIF END SUBROUTINE manual_3D_bcast +SUBROUTINE simpson_rule_z(f,intf) + ! integrate f(z) over z using the simpon's rule. Assume periodic boundary conditions (f(ize+1) = f(izs)) + !from molix BJ Frei + use prec_const + use grid + ! + implicit none + ! + complex(dp),dimension(izs:ize), intent(in) :: f + COMPLEX(dp), intent(out) :: intf + ! + COMPLEX(dp) :: buff_ + ! + IF(Nz .GT. 1) THEN + IF(mod(Nz,2) .ne. 0 ) THEN + ERROR STOP 'Simpson rule: Nz must be an even number !!!!' + ENDIF + ! + buff_ = 0._dp + ! + DO iz = izs, Nz/2 + IF(iz .eq. Nz/2) THEN ! ... iz = ize + buff_ = buff_ + (f(izs) + 4._dp*f(ize) + f(ize-1 )) + ELSE + buff_ = buff_ + (f(2*iz+1) + 4._dp*f(2*iz) + f(2*iz-1 )) + ENDIF + ENDDO + ! + ! + intf = buff_*deltaz/3._dp + ! + ELSE + intf = f(izs) + ENDIF +END SUBROUTINE simpson_rule_z + +SUBROUTINE o2e_z(fo,fe) + ! gives the value of a field from the odd grid to the even one + use prec_const + use grid + ! + implicit none + ! + COMPLEX(dp),dimension(1:Nz), intent(in) :: fo + COMPLEX(dp),dimension(1:Nz), intent(out) :: fe ! + ! + DO iz = 2,Nz + fe(iz) = 0.5_dp*(fo(iz)+fo(iz-1)) + ENDDO + ! Periodic boundary conditions + fe(1) = 0.5_dp*(fo(1) + fo(Nz)) +END SUBROUTINE o2e_z + +SUBROUTINE e2o_z(fe,fo) + ! gives the value of a field from the even grid to the odd one + use prec_const + use grid + ! + implicit none + ! + COMPLEX(dp),dimension(1:Nz), intent(in) :: fe + COMPLEX(dp),dimension(1:Nz), intent(out) :: fo + ! + DO iz = 1,Nz-1 + fo(iz) = 0.5_dp*(fe(iz+1)+fe(iz)) + ENDDO + ! Periodic boundary conditions + fo(Nz) = 0.5_dp*(fe(1) + fe(Nz)) +END SUBROUTINE e2o_z + END MODULE utility diff --git a/wk/analysis_3D.m b/wk/analysis_3D.m index cf0111b..eff2e01 100644 --- a/wk/analysis_3D.m +++ b/wk/analysis_3D.m @@ -1,313 +1,351 @@ addpath(genpath('../matlab')) % ... add addpath(genpath('../matlab/plots')) % ... add outfile =''; %% Directory of the simulation if 1% Local results outfile =''; -outfile ='simulation_A/1024x256_3x2_L_120_kN_1.6667_nu_1e-01_DGGK'; +outfile =''; +outfile ='fluxtube_salphaB_s0/50x100x20_5x3_L_300_q0_2.7_e_0.18_kN_2.22_kT_6_nu_1e-01_DGGK_lin'; +% outfile ='fluxtube_salphaB_s0/64x64x16_5x3_L_200_q0_2.7_e_0.18_kN_2.22_kT_6_nu_1e-01_DGGK'; +% outfile ='simulation_A/1024x256_3x2_L_120_kN_1.6667_nu_1e-01_DGGK'; % outfile ='Linear_Device/64x64x20_5x2_Lx_20_Ly_150_q0_25_kN_0.24_kT_0.03_nu_1e-02_DGGK'; BASIC.RESDIR = ['../results/',outfile,'/']; BASIC.MISCDIR = ['/misc/HeLaZ_outputs/results/',outfile,'/']; system(['mkdir -p ',BASIC.MISCDIR]); CMD = ['cp ', BASIC.RESDIR,'outputs* ',BASIC.MISCDIR]; disp(CMD); system(CMD); else% Marconi results -outfile ='/marconi_scratch/userexternal/ahoffman/HeLaZ/results/simulation_A/300x150_L_120_P_8_J_4_eta_0.6_nu_1e-01_PAGK_mu_0e+00/out.txt'; +outfile ='/marconi_scratch/userexternal/ahoffman/HeLaZ/results/simulation_A/300x300_L_120_P_8_J_4_eta_0.6_nu_1e-01_PAGK_mu_0e+00/out.txt'; % outfile ='/marconi_scratch/userexternal/ahoffman/HeLaZ/results/simulation_B/300x150_L_120_P_8_J_4_eta_0.6_nu_5e-01_SGGK_mu_0e+00/out.txt'; % outfile ='/marconi_scratch/userexternal/ahoffman/HeLaZ/results/simulation_A/500x500_L_120_P_4_J_2_eta_0.6_nu_1e-01_DGGK_mu_0e+00/out.txt'; BASIC.RESDIR = ['../',outfile(46:end-8),'/']; BASIC.MISCDIR = ['/misc/HeLaZ_outputs/',outfile(46:end-8),'/']; end %% Load the results % Load outputs from jobnummin up to jobnummax -JOBNUMMIN = 03; JOBNUMMAX = 03; +JOBNUMMIN = 00; JOBNUMMAX = 20; % JOBNUMMIN = 07; JOBNUMMAX = 20; % For CO damping sim A compile_results %Compile the results from first output found to JOBNUMMAX if existing %% Post-processing post_processing %% PLOTS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% default_plots_options disp('Plots') FMT = '.fig'; -if 0 -%% Time evolutions and growth rate -plot_time_evolution_and_gr -end - if 1 %% Space time diagramm (fig 11 Ivanov 2020) TAVG_0 = 1500; TAVG_1 = 4000; % Averaging times duration plot_radial_transport_and_shear end -if 0 -%% Space time diagramms -cmax = 0.00001 % max of the colorbar for transport -tstart = 0; tend = Ts3D(end); % time window -plot_space_time_diagrams -end - -if 0 -%% |phi_k|^2 spectra (Kobayashi 2015 fig 3) -% tstart = 0.8*Ts3D(end); tend = Ts3D(end); % Time window -tstart = 1000; tend = 4000; -% tstart = 10000; tend = 12000; -% Chose the field to plot -% FIELD = Ni00; FNAME = 'Ni00'; FIELDLTX = 'N_i^{00}'; -% FIELD = Ne00; FNAME = 'Ne00'; FIELDLTX = 'N_e^{00}' -FIELD = PHI; FNAME = 'PHI'; FIELDLTX = '\tilde\phi'; -% FIELD_ = fft2(Gamma_x); FIELD = FIELD_(1:76,:,:,:); FNAME = 'Gamma_x'; FIELDLTX = '\tilde\Gamma_x'; -LOGSCALE = 1; TRENDS = 1; NORMALIZED = 0; -plot_kperp_spectrum -end if 0 %% MOVIES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Options -t0 =000; iz = 1; ix = 1; iy = 1; +t0 =000; iz = 2; ix = 1; iy = 1; skip_ =1; FPS = 30; DELAY = 1/FPS; [~, it03D] = min(abs(Ts3D-t0)); FRAMES_3D = it03D:skip_:numel(Ts3D); [~, it05D] = min(abs(Ts5D-t0)); FRAMES_5D = it05D:skip_:numel(Ts5D); T = Ts3D; FRAMES = FRAMES_3D; INTERP = 0; NORMALIZED = 1; CONST_CMAP = 0; BWR =1;% Gif options % Field to plot % FIELD = dens_i; NAME = 'ni'; FIELDNAME = 'n_i'; % FIELD = dens_i-Z_n_i; NAME = 'ni_NZ';FIELDNAME = 'n_i^{NZ}'; % FIELD = temp_i; NAME = 'Ti'; FIELDNAME = 'n_i'; % FIELD = temp_i-Z_T_i; NAME = 'Ti_NZ';FIELDNAME = 'T_i^{NZ}'; % FIELD = ne00; NAME = 'ne00'; FIELDNAME = 'n_e^{00}'; -FIELD = ni00; NAME = 'ni00'; FIELDNAME = 'n_i^{00}'; -% FIELD = phi; NAME = 'phi'; FIELDNAME = '\phi'; +% FIELD = ni00; NAME = 'ni00'; FIELDNAME = 'n_i^{00}'; +FIELD = phi; NAME = 'phi'; FIELDNAME = '\phi'; % FIELD = phi-Z_phi; NAME = 'NZphi'; FIELDNAME = '\phi_{NZ}'; % FIELD = Gamma_x; NAME = 'Gamma_x'; FIELDNAME = '\Gamma_x'; % Sliced -% plt = @(x) real(x(ix, :, :,:)); X = Y_YZ; Y = Z_YZ; XNAME = 'y'; YNAME = 'z'; +plt = @(x) real(x(ix, :, :,:)); X = Y_YZ; Y = Z_YZ; XNAME = 'y'; YNAME = 'z'; % plt = @(x) real(x( :,iy, :,:)); X = X_XZ; Y = Z_XZ; XNAME = 'x'; YNAME = 'z'; -plt = @(x) real(x( :, :,iz,:)); X = X_XY; Y = Y_XY; XNAME = 'x'; YNAME = 'y'; +% plt = @(x) real(x( :, :,iz,:)); X = X_XY; Y = Y_XY; XNAME = 'x'; YNAME = 'y'; % K-space % FIELD = PHI; NAME = 'PHI'; FIELDNAME = '\tilde \phi'; % FIELD = Ne00; NAME = 'Ne00'; FIELDNAME = 'N_e^{00}'; % FIELD = Ni00; NAME = 'Ni00'; FIELDNAME = 'N_i^{00}'; % plt = @(x) fftshift((abs(x( :, :,1,:))),2); X = fftshift(KX,2); Y = fftshift(KY,2); XNAME = 'k_x'; YNAME = 'k_y'; % Averaged % plt = @(x) mean(x,1); X = Y_YZ; Y = Z_YZ; XNAME = 'y'; YNAME = 'z'; % plt = @(x) mean(x,2); X = X_XZ; Y = Z_XZ; XNAME = 'x'; YNAME = 'z'; % plt = @(x) mean(x,3); X = X_XY; Y = Y_XY; XNAME = 'x'; YNAME = 'y'; FIELD = squeeze(plt(FIELD)); % Naming GIFNAME = [NAME,sprintf('_%.2d',JOBNUM),'_',PARAMS]; % Create movie (gif or mp4) create_gif % create_mov end if 0 -%% Photomaton : real space +%% 2D plot : real space % Chose the field to plot % FIELD = ni00; FNAME = 'ni00'; FIELDLTX = 'n_i^{00}'; -FIELD = ne00; FNAME = 'ne00'; FIELDLTX = 'n_e^{00}' +% FIELD = ne00; FNAME = 'ne00'; FIELDLTX = 'n_e^{00}' % FIELD = dens_i; FNAME = 'ni'; FIELDLTX = 'n_i'; % FIELD = dens_e; FNAME = 'ne'; FIELDLTX = 'n_e'; % FIELD = dens_e-Z_n_e; FNAME = 'ne_NZ'; FIELDLTX = 'n_e^{NZ}'; % FIELD = dens_i-Z_n_i; FNAME = 'ni_NZ'; FIELDLTX = 'n_i^{NZ}'; % FIELD = temp_i; FNAME = 'Ti'; FIELDLTX = 'T_i'; % FIELD = temp_e; FNAME = 'Te'; FIELDLTX = 'T_e'; % FIELD = phi; FNAME = 'phi'; FIELDLTX = '\phi'; -% FIELD = Z_phi-phi; FNAME = 'phi_NZ'; FIELDLTX = '\phi^{NZ}'; +FIELD = Z_phi-phi; FNAME = 'phi_NZ'; FIELDLTX = '\phi^{NZ}'; % FIELD = Z_phi; FNAME = 'phi_Z'; FIELDLTX = '\phi^{Z}'; % FIELD = Gamma_x; FNAME = 'Gamma_x'; FIELDLTX = '\Gamma_x'; % FIELD = dens_e-Z_n_e-(Z_phi-phi); FNAME = 'Non_adiab_part'; FIELDLTX = 'n_e^{NZ}-\phi^{NZ}'; % Chose when to plot it -tf = 1500:500:3000; +tf = [0 15 27 28 30]; -% Sliced -ix = 1; iy = 1; iz = 1; +% Planar plot: choose a plane to plot at x0/y0/z0 coordinates +x0 = 0.0; y0 = 0.0; z0 = 0.0; +[~,ix] = min(abs(x-x0)); [~,iy] = min(abs(y-y0)); [~,iz] = min(abs(z-z0)); % plt = @(x,it) real(x(ix, :, :,it)); X = Y_YZ; Y = Z_YZ; XNAME = 'y'; YNAME = 'z'; FIELDLTX = [FIELDLTX,'(x=',num2str(round(x(ix))),')'] % plt = @(x,it) real(x( :,iy, :,it)); X = X_XZ; Y = Z_XZ; XNAME = 'x'; YNAME = 'z'; FIELDLTX = [FIELDLTX,'(y=',num2str(round(y(iy))),')'] plt = @(x,it) real(x( :, :,iz,it)); X = X_XY; Y = Y_XY; XNAME = 'x'; YNAME = 'y'; FIELDLTX = [FIELDLTX,'(z=',num2str(round(z(iz)/pi)),'\pi)'] % Averaged % plt = @(x,it) mean(x(:,:,:,it),1); X = Y_YZ; Y = Z_YZ; XNAME = 'y'; YNAME = 'z'; FIELDLTX = ['\langle ',FIELDLTX,'\rangle_x'] % plt = @(x,it) mean(x(:,:,:,it),2); X = X_XZ; Y = Z_XZ; XNAME = 'x'; YNAME = 'z'; FIELDLTX = ['\langle ',FIELDLTX,'\rangle_y'] % plt = @(x,it) mean(x(:,:,:,it),3); X = X_XY; Y = Y_XY; XNAME = 'x'; YNAME = 'y'; FIELDLTX = ['\langle ',FIELDLTX,'\rangle_z'] % TNAME = []; fig = figure; FIGNAME = [FNAME,TNAME,'_snaps','_',PARAMS]; set(gcf, 'Position', [100, 100, 1500, 350]) plt_2 = @(x) x;%./max(max(x)); for i_ = 1:numel(tf) [~,it] = min(abs(Ts3D-tf(i_))); TNAME = [TNAME,'_',num2str(Ts3D(it))]; subplot(1,numel(tf),i_) DATA = plt_2(squeeze(plt(FIELD,it))); pclr = pcolor((X),(Y),DATA); set(pclr, 'edgecolor','none');pbaspect([1 1 1]) colormap(bluewhitered); %caxis([-30,30]); xlabel(latexize(XNAME)); ylabel(latexize(YNAME));set(gca,'ytick',[]); title(sprintf('$t c_s/R=%.0f$',Ts3D(it))); end legend(latexize(FIELDLTX)); save_figure end if 0 -%% Photomaton : k space +%% 2D plot : k space % Chose the field to plot % FIELD = Ni00; FNAME = 'Ni00'; FIELDLTX = 'N_i^{00}'; -FIELD = Ne00; FNAME = 'Ne00'; FIELDLTX = 'N_e^{00}' -% FIELD = PHI; FNAME = 'PHI'; FIELDLTX = '\tilde\phi'; +% FIELD = Ne00; FNAME = 'Ne00'; FIELDLTX = 'N_e^{00}' +FIELD = PHI; FNAME = 'PHI'; FIELDLTX = '\tilde\phi'; % FIELD_ = fft2(Gamma_x); FIELD = FIELD_(1:Nx/2+1,:,:,:); FNAME = 'Gamma_x'; FIELDLTX = '\tilde\Gamma_x'; % FIELD_ = fft2(dens_e); FIELD = FIELD_(1:Nx/2+1,:,:,:); FNAME = 'FFT_Dens_e'; FIELDLTX = '\tilde n_e'; % Chose when to plot it -tf = 1500:500:3000; +tf = [0 15 27 28 30]; % tf = 8000; -% Sliced -ix = 1; iy = 1; iz = 1; +% Planar plot: choose a plane to plot at x0/y0/z0 coordinates +x0 = 0.0; y0 = 0.3; z0 = 0.5*pi; +[~,ix] = min(abs(x-x0)); [~,iy] = min(abs(y-y0)); [~,iz] = min(abs(z-z0)); % plt = @(x,it) abs(x(ix, :, :,it)); X = KY_YZ; Y = KZ_YZ; XNAME = 'k_y'; YNAME = 'z'; FIELDLTX = [FIELDLTX,'(k_x=',num2str(round(kx(ix))),')']; % plt = @(x,it) abs(x( :,iy, :,it)); X = KX_XZ; Y = KZ_XZ; XNAME = 'k_x'; YNAME = 'z'; FIELDLTX = [FIELDLTX,'(k_y=',num2str(round(ky(iy))),')']; -plt = @(x,it) abs(x( :, :,iz,it)); X = KX_XY; Y = KY_XY; XNAME = 'k_x'; YNAME = 'k_y'; FIELDLTX = [FIELDLTX,'(z=',num2str((z(iz)/pi)),'\pi)']; +% plt = @(x,it) abs(x( :, :,iz,it)); X = KX_XY; Y = KY_XY; XNAME = 'k_x'; YNAME = 'k_y'; FIELDLTX = [FIELDLTX,'(z=',num2str((z(iz)/pi)),'\pi)']; +% % +% plt_x = @(x) fftshift(x,1); plt_y = @(x) fftshift(x,1); plt_z = @(x) fftshift(x,1); plt = @(x,it) max(abs(x( :, :,:,it)),[],1); +% X = KY_YZ; Y = KZ_YZ; XNAME = 'k_y'; YNAME = 'z'; FIELDLTX = [FIELDLTX,'(\max_x)']; +% +% plt_x = @(x) fftshift(x,2); plt_y = @(x) fftshift(x,1); plt_z = @(x) fftshift(x,2); plt = @(x,it) max(abs(x( :, :,:,it)),[],2); +% X = KX_XZ; Y = KZ_XZ; XNAME = 'k_x'; YNAME = 'z'; FIELDLTX = [FIELDLTX,'(\max_y)']; + +plt_x = @(x) fftshift(x,2); plt_y = @(x) fftshift(x,2); plt_z = @(x) fftshift(x,2); plt = @(x,it) max(abs(x( :, :,:,it)),[],3); +X = KX_XY; Y = KY_XY; XNAME = 'k_x'; YNAME = 'k_y'; FIELDLTX = [FIELDLTX,'(\max_z)']; % TNAME = []; fig = figure; FIGNAME = [FNAME,TNAME,'_snaps','_',PARAMS]; set(gcf, 'Position', [100, 100, 300*numel(tf), 500]) -plt_2 = @(x) (fftshift(x,2)); for i_ = 1:numel(tf) [~,it] = min(abs(Ts3D-tf(i_))); TNAME = [TNAME,'_',num2str(Ts3D(it))]; subplot(1,numel(tf),i_) DATA = plt_2(squeeze(plt(FIELD,it))); - pclr = pcolor(fftshift(X,2),fftshift(Y,2),DATA); set(pclr, 'edgecolor','none');pbaspect([0.5 1 1]) - caxis([0 1]*5e3); + pclr = pcolor(plt_x(X),plt_y(Y),plt_z(DATA)); set(pclr, 'edgecolor','none');pbaspect([0.5 1 1]) +% caxis([0 1]*5e3); % caxis([-1 1]*5); xlabel(latexize(XNAME)); ylabel(latexize(YNAME)); if(i_ > 1); set(gca,'ytick',[]); end; title(sprintf('$t c_s/R=%.0f$',Ts3D(it))); end legend(latexize(FIELDLTX)); save_figure end if 0 %% TAVG_0 = 1000; TAVG_1 = 5000; % Averaging times duration ZF_fourier_analysis end if 0 %% plot_param_evol end if 0 %% Radial shear profile (with moving average) tf = 1000+[0:100:1000]; ymax = 0; figure for i_ = 1:numel(tf) [~,it] = min(abs(Ts3D-tf(i_))); data = squeeze((mean(dx2phi(:,:,1,it),2))); step = 50; plot(movmean(x,step),movmean(data,step),'Displayname',sprintf('$t c_s/R=%.0f$',Ts3D(it))); hold on; ymax = max([ymax abs(min(data)) abs(max(data))]); end xlim([min(x), max(x)]); ylim(1.2*[-1 1]*ymax); xlabel('$x/\rho_s$'); ylabel('$s_{E\times B,x}$'); grid on end -if 1 +if 0 %% zonal vs nonzonal energies for phi(t) it0 = 01; itend = Ns3D; trange = it0:itend; pltx = @(x) x;%-x(1); plty = @(x) x./max(squeeze(x)); fig = figure; FIGNAME = ['ZF_turb_energy_vs_time_',PARAMS]; set(gcf, 'Position', [100, 100, 1400, 500]) subplot(121) % yyaxis left semilogy(pltx(Ts3D(trange)),plty(Ephi_Z(trange)),'DisplayName',['Zonal, ',CONAME]); hold on; % yyaxis right semilogy(pltx(Ts3D(trange)),plty(Ephi_NZ_kgt0(trange)),'DisplayName',['NZ, $k_p>0$, ',CONAME]); semilogy(pltx(Ts3D(trange)),plty(Ephi_NZ_kgt1(trange)),'DisplayName',['NZ, $k_p>1$, ',CONAME]); semilogy(pltx(Ts3D(trange)),plty(Ephi_NZ_kgt2(trange)),'DisplayName',['NZ, $k_p>2$, ',CONAME]); % semilogy(pltx(Ts0D),plty(PGAMMA_RI),'DisplayName',['$\Gamma_x$, ',CONAME]); title('Energy'); legend('Location','southeast') xlim([Ts3D(it0), Ts3D(itend)]); ylim([1e-3, 1.5]) xlabel('$t c_s/R$'); grid on;% xlim([0 500]); subplot(122) plot(plty(Ephi_Z(trange)),plty(Ephi_NZ_kgt0(trange))); title('Phase space'); legend(CONAME) xlabel('$E_Z$'); ylabel('$E_{NZ}$'); grid on;% xlim([0 500]); end if 0 %% Conservation laws Nxmax = Nx/2; Nymax = Ny/2; mflux_x_i = squeeze(sum((Gamma_x( 1,1:Nxmax,:)+Gamma_x( 1,2:Nxmax+1,:))/2,2)./sum(Gamma_x( 1,1:Nxmax,:))); mflux_x_o = squeeze(sum((Gamma_x( Nxmax,1:Nxmax,:)+Gamma_x( Nxmax,2:Nxmax+1,:))/2,2)./sum(Gamma_x( Nxmax,1:Nxmax,:))); mflux_y_i = squeeze(sum((Gamma_y(1:Nxmax, 1,:)+Gamma_y(2:Nxmax+1, 1,:))/2,1)./sum(Gamma_y(1:Nxmax, 1,:))); mflux_y_o = squeeze(sum((Gamma_y(1:Nxmax, Nymax,:)+Gamma_y(2:Nxmax+1, Nymax,:))/2,1)./sum(Gamma_y(1:Nxmax, Nymax,:))); mass_cons = mflux_x_i - mflux_x_o + mflux_y_i - mflux_y_o; %% figure plt = @(x) squeeze(mean(mean(x(:,:,1,:),1),2)); subplot(211) plot(Ts3D,plt(dens_e+dens_i),'DisplayName','$\delta n_e + \delta n_i$'); hold on; plot(Ts3D,plt(ne00+ni00),'DisplayName','$\delta n_e^{00} + \delta n_i^{00}$'); hold on; plot(Ts3D,plt(temp_e+temp_i),'DisplayName','$\delta T_e + \delta T_i$'); hold on; legend('show'); grid on; xlim([Ts3D(1) Ts3D(end)]) subplot(212); plot(Ts3D,mass_cons*(2*pi/Nx/Ny)^2,'DisplayName','in-out'); hold on % plot(Ts3D,squeeze(mflux_x_i),'DisplayName','Flux i x'); % plot(Ts3D,squeeze(mflux_x_o),'DisplayName','Flux o x'); % plot(Ts3D,squeeze(mflux_y_i),'DisplayName','Flux i y'); % plot(Ts3D,squeeze(mflux_y_o),'DisplayName','Flux o y'); legend('show'); grid on; xlim([Ts3D(1) Ts3D(end)]); %ylim([-0.1, 2]*mean(mflux_x_i)) end if 0 %% Zonal profiles (ky=0) % Chose the field to plot FIELD = Ne00.*conj(Ne00); FNAME = 'Ne002'; FIELDLTX = '|N_e^{00}|^2' % FIELD = Ni00.*conj(Ni00); FNAME = 'Ni002'; FIELDLTX = '|N_i^{00}|^2' % FIELD = abs(PHI); FNAME = 'absPHI'; FIELDLTX = '|\tilde\phi|'; % FIELD = PHI.*conj(PHI); FNAME = 'PHI2'; FIELDLTX = '|\tilde\phi|^2'; % FIELD_ = fft2(Gamma_x); FIELD = FIELD_(1:Nx/2+1,:,:,:); FNAME = 'Gamma_x'; FIELDLTX = '\tilde\Gamma_x'; % FIELD_ = fft2(dens_e); FIELD = FIELD_(1:Nx/2+1,:,:,:); FNAME = 'FFT_Dens_e'; FIELDLTX = '\tilde n_e'; % Chose when to plot it tf = 1500:200:2500; % tf = 8000; % Sliced plt = @(x,it) x( 2:end, 1,1,it)./max(max(x( 2:end, 1,1,:))); XNAME = 'k_x'; % TNAME = []; fig = figure; FIGNAME = ['Zonal_',FNAME,TNAME,'_snaps','_',PARAMS]; set(gcf, 'Position', [100, 100, 600,400]) plt_2 = @(x) (fftshift(x,2)); for i_ = 1:numel(tf) [~,it] = min(abs(Ts3D-tf(i_))); TNAME = [TNAME,'_',num2str(Ts3D(it))]; DATA = plt_2(squeeze(plt(FIELD,it))); semilogy(kx(2:end),DATA,'-','DisplayName',sprintf('$t c_s/R=%.0f$',Ts3D(it))); hold on; grid on; xlabel(latexize(XNAME)); end title(['$',FIELDLTX,'$ Zonal Spectrum']); legend('show'); save_figure +end + +if 0 +%% Time evolutions and growth rate +plot_time_evolution_and_gr +end + +if 0 +%% |phi_k|^2 spectra (Kobayashi 2015 fig 3) +% tstart = 0.8*Ts3D(end); tend = Ts3D(end); % Time window +tstart = 1000; tend = 4000; +% tstart = 10000; tend = 12000; +% Chose the field to plot +% FIELD = Ni00; FNAME = 'Ni00'; FIELDLTX = 'N_i^{00}'; +% FIELD = Ne00; FNAME = 'Ne00'; FIELDLTX = 'N_e^{00}' +FIELD = PHI; FNAME = 'PHI'; FIELDLTX = '\tilde\phi'; +% FIELD_ = fft2(Gamma_x); FIELD = FIELD_(1:76,:,:,:); FNAME = 'Gamma_x'; FIELDLTX = '\tilde\Gamma_x'; +LOGSCALE = 1; TRENDS = 1; NORMALIZED = 0; +plot_kperp_spectrum +end + +if 0 +%% Torus plot +aminor = EPS; % Torus minor radius +Rmajor = 1.; % Torus major radius +theta = linspace(-pi, pi, 30) ; % Poloidal angle +phi = linspace(0., 2.*pi, 30) ; % Toroidal angle +[t, p] = meshgrid(phi, theta); +x = (Rmajor + aminor.*cos(p)) .* cos(t); +y = (Rmajor + aminor.*cos(p)) .* sin(t); +z = aminor.*sin(p); +figure; +torus=surf(x, y, z); hold on;alpha 1.0;%light('Position',[-1 1 1],'Style','local') +set(torus,'edgecolor',[1 1 1]*0.8,'facecolor','none') +xlabel('X');ylabel('Y');zlabel('Z'); +% field line plot +Nturns = 1; +theta = linspace(-Nturns*pi, Nturns*pi, 512) ; % Poloidal angle +xFL = (Rmajor + aminor.*cos(theta)) .* cos(theta*Q0); +yFL = (Rmajor + aminor.*cos(theta)) .* sin(theta*Q0); +zFL = aminor.*sin(theta); +plot3(xFL,yFL,zFL,'r') +% Planes plot +theta = linspace(-pi, pi, Nz) ; % Poloidal angle +xFL = (Rmajor + aminor.*cos(theta)) .* cos(theta*Q0); +yFL = (Rmajor + aminor.*cos(theta)) .* sin(theta*Q0); +zFL = aminor.*sin(theta); +plot3(xFL,yFL,zFL,'sb') +axis equal + end \ No newline at end of file diff --git a/wk/linear_1D_entropy_mode.m b/wk/linear_1D_entropy_mode.m index e1cd8d8..95365b4 100644 --- a/wk/linear_1D_entropy_mode.m +++ b/wk/linear_1D_entropy_mode.m @@ -1,155 +1,155 @@ RUN = 1; % To run or just to load addpath(genpath('../matlab')) % ... add default_plots_options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Set Up parameters CLUSTER.TIME = '99:00:00'; % allocation time hh:mm:ss %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% PHYSICAL PARAMETERS NU = 0.1; % Collision frequency TAU = 1.0; % e/i temperature ratio K_N = 1/0.6; % Density gradient drive K_T = 0.0; % Temperature ''' K_E = 0.0; % Electrostat ''' SIGMA_E = 0.0233380; % mass ratio sqrt(m_a/m_i) (correct = 0.0233380) %% GRID PARAMETERS -Nx = 100; % real space x-gridpoints -Ny = 1; % '' y-gridpoints -Lx = 150; % Size of the squared frequency domain -Ly = 1; % Size of the squared frequency domain -Nz = 1; % number of perpendicular planes (parallel grid) -q0 = 1.0; % safety factor -shear = 0.0; % magnetic shear -eps = 0.0; % inverse aspect ratio +NX = 100; % real space x-gridpoints +NY = 1; % '' y-gridpoints +LX = 150; % Size of the squared frequency domain +LY = 1; % Size of the squared frequency domain +NZ = 1; % number of perpendicular planes (parallel grid) +Q0 = 1.0; % safety factor +SHEAR = 0.0; % magnetic shear +EPS = 0.0; % inverse aspect ratio %% TIME PARMETERS TMAX = 100; % Maximal time unit DT = 1e-2; % Time step SPS0D = 1; % Sampling per time unit for 2D arrays SPS2D = 0; % Sampling per time unit for 2D arrays SPS3D = 1; % Sampling per time unit for 2D arrays SPS5D = 1; % Sampling per time unit for 5D arrays SPSCP = 0; % Sampling per time unit for checkpoints JOB2LOAD= -1; %% OPTIONS -SIMID = 'test_4.1'; % Name of the simulation +SIMID = 'Linear_entropy_mode'; % Name of the simulation NON_LIN = 0; % activate non-linearity (is cancelled if KXEQ0 = 1) +KIN_E = 1; % Collision operator % (0:L.Bernstein, 1:Dougherty, 2:Sugama, 3:Pitch angle, 4:Full Couloumb ; +/- for GK/DK) CO = 2; INIT_ZF = 0; ZF_AMP = 0.0; CLOS = 0; % Closure model (0: =0 truncation, 1: gyrofluid closure (p+2j<=Pmax)) NL_CLOS = 0; % nonlinear closure model (-2:nmax=jmax; -1:nmax=jmax-j; >=0:nmax=NL_CLOS) KERN = 0; % Kernel model (0 : GK) INIT_PHI= 0; % Start simulation with a noisy phi %% OUTPUTS W_DOUBLE = 1; W_GAMMA = 1; W_HF = 1; W_PHI = 1; W_NA00 = 1; W_DENS = 1; W_TEMP = 1; W_NAPJ = 1; W_SAPJ = 0; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % unused HD_CO = 0.5; % Hyper diffusivity cutoff ratio -kmax = Nx*pi/Lx;% Highest fourier mode +kmax = NX*pi/LX;% Highest fourier mode NU_HYP = 0.0; % Hyperdiffusivity coefficient MU = NU_HYP/(HD_CO*kmax)^4; % Hyperdiffusivity coefficient INIT_BLOB = 0; WIPE_TURB = 0; WIPE_ZF = 0; MU_P = 0.0; % Hermite hyperdiffusivity -mu_p*(d/dvpar)^4 f MU_J = 0.0; % Laguerre hyperdiffusivity -mu_j*(d/dvperp)^4 f LAMBDAD = 0.0; NOISE0 = 1.0e-5; % Init noise amplitude BCKGD0 = 0.0; % Init background GRADB = 1.0; CURVB = 1.0; %% PARAMETER SCANS if 1 %% Parameter scan over PJ % PA = [2 4]; % JA = [1 2]; PA = [4]; JA = [2]; DTA= DT*ones(size(JA));%./sqrt(JA); % DTA= DT; mup_ = MU_P; muj_ = MU_J; Nparam = numel(PA); param_name = 'PJ'; -gamma_Ni00 = zeros(Nparam,floor(Nx/2)+1); -gamma_Nipj = zeros(Nparam,floor(Nx/2)+1); -gamma_phi = zeros(Nparam,floor(Nx/2)+1); +gamma_Ni00 = zeros(Nparam,floor(NX/2)+1); +gamma_Nipj = zeros(Nparam,floor(NX/2)+1); +gamma_phi = zeros(Nparam,floor(NX/2)+1); for i = 1:Nparam % Change scan parameter PMAXE = PA(i); PMAXI = PA(i); JMAXE = JA(i); JMAXI = JA(i); DT = DTA(i); setup system(['rm fort*.90']); % Run linear simulation if RUN % system(['cd ../results/',SIMID,'/',PARAMS,'/; mpirun -np 6 ./../../../bin/helaz 1 6 0; cd ../../../wk']) % system(['cd ../results/',SIMID,'/',PARAMS,'/; mpirun -np 2 ./../../../bin/helaz 1 2 0; cd ../../../wk']) system(['cd ../results/',SIMID,'/',PARAMS,'/; ./../../../bin/helaz 0; cd ../../../wk']) end % Load and process results %% filename = ['../results/',SIMID,'/',PARAMS,'/outputs_00.h5']; load_results - for ikx = 1:Nx/2+1 + for ikx = 1:NX/2+1 tend = max(Ts3D(abs(Ni00(ikx,1,1,:))~=0)); tstart = 0.6*tend; [~,itstart] = min(abs(Ts3D-tstart)); [~,itend] = min(abs(Ts3D-tend)); trange = itstart:itend; % exp fit on moment 00 X_ = Ts3D(trange); Y_ = squeeze(abs(Ni00(ikx,1,1,trange))); gamma_Ni00(i,ikx) = LinearFit_s(X_,Y_); % exp fit on phi X_ = Ts3D(trange); Y_ = squeeze(abs(PHI(ikx,1,1,trange))); gamma_phi (i,ikx) = LinearFit_s(X_,Y_); end gamma_Ni00(i,:) = real(gamma_Ni00(i,:));% .* (gamma_Ni00(i,:)>=0.0)); gamma_Nipj(i,:) = real(gamma_Nipj(i,:));% .* (gamma_Nipj(i,:)>=0.0)); if 0 %% Fit verification figure; for i = 1:1:Nx/2+1 X_ = Ts3D(:); Y_ = squeeze(abs(Ni00(i,1,1,:))); semilogy(X_,Y_,'DisplayName',['k=',num2str(kx(i))]); hold on; end end if 1 %% Plot SCALE = 1;%sqrt(2); fig = figure; FIGNAME = 'linear_study'; plt = @(x) x; % subplot(211) for i = 1:Nparam clr = line_colors(mod(i-1,numel(line_colors(:,1)))+1,:); linestyle = line_styles(floor((i-1)/numel(line_colors(:,1)))+1); plot(plt(SCALE*kx),plt(gamma_phi(i,1:end)),... 'Color',clr,... 'LineStyle',linestyle{1},'Marker','^',... ...% 'DisplayName',['$\kappa_N=',num2str(K_N),'$, $\nu_{',CONAME,'}=',num2str(NU),'$, $P=',num2str(PA(i)),'$, $J=',num2str(JA(i)),'$']); 'DisplayName',[CONAME,', $P,J=',num2str(PA(i)),',',num2str(JA(i)),'$']); hold on; end grid on; xlabel('$k_y\rho_s^{R}$'); ylabel('$\gamma(\phi)L_\perp/c_s$'); xlim([0.0,max(kx)]); title(['$\kappa_N=',num2str(K_N),'$, $\nu_{',CONAME,'}=',num2str(NU),'$']) -% title(['$\nabla N = 0$', ', $\nu=',num2str(NU),'$']) legend('show'); %xlim([0.01,10]) -saveas(fig,[SIMDIR,'gamma_Ni_vs_',param_name,'_',PARAMS,'.fig']); -saveas(fig,[SIMDIR,'gamma_Ni_vs_',param_name,'_',PARAMS,'.png']); +saveas(fig,[SIMDIR,'/',PARAMS,'/gamma_vs_',param_name,'_',PARAMS,'.fig']); +saveas(fig,[SIMDIR,'/',PARAMS,'/gamma_vs_',param_name,'_',PARAMS,'.png']); end end if 0 %% Space time [YT,XT] = meshgrid(Ts3D,kx); figure; % pclr = surf(XT,YT,squeeze(abs(PHI_ST(1,:,:)))); set(pclr, 'edgecolor','none'); colorbar; % pclr = pcolor(XT,YT,squeeze(abs(Ni00_ST(1,:,:)))); set(pclr, 'edgecolor','none'); colorbar; semilogy(Ts3D(1:TMAX/SPS3D),squeeze(abs(PHI_ST(1,50:5:100,:)))); end end \ No newline at end of file diff --git a/wk/local_run.m b/wk/local_run.m index 0120ca2..0ed013d 100644 --- a/wk/local_run.m +++ b/wk/local_run.m @@ -1,78 +1,80 @@ addpath(genpath('../matlab')) % ... add %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Set Up parameters CLUSTER.TIME = '99:00:00'; % allocation time hh:mm:ss %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% PHYSICAL PARAMETERS NU = 0.1; % Collision frequency -K_N = 1/0.6; % Density gradient drive (R/Ln) -K_T = 0.00; % Temperature gradient -K_E = 0.00; % Electrostat gradient +K_N = 2.22; % Density gradient drive +K_T = 6.0; % Temperature ''' +K_E = 0.00; % Electrostat gradient +SIGMA_E = 0.05196; % mass ratio sqrt(m_a/m_i) (correct = 0.0233380) NU_HYP = 0.0; +KIN_E = 1; % Kinetic (1) or adiabatic (2) electron model %% GRID PARAMETERS -Nx = 1024; % Spatial radial resolution ( = 2x radial modes) -Lx = 120; % Radial window size -Ny = 256; % Spatial azimuthal resolution (= azim modes) -Ly = 120; % Azimuthal window size -Nz = 1; % number of perpendicular planes (parallel grid) -q0 = 1.0; % safety factor (Lz = 2*pi*q0) -P = 2; -J = 1; +NX = 50; % Spatial radial resolution ( = 2x radial modes) +LX = 300; % Radial window size +NY = 100; % Spatial azimuthal resolution (= azim modes) +LY = 300; % Azimuthal window size +NZ = 20; % number of perpendicular planes (parallel grid) +P = 4; +J = 2; %% GEOMETRY PARAMETERS -shear = 0.0; % magnetic shear -eps = 0.0; % inverse aspect ratio (controls parallel magnetic gradient) -gradB = 0.0; % Magnetic gradient -curvB = 0.0; % Magnetic curvature +Q0 = 2.7; % safety factor +SHEAR = 0.0; % magnetic shear +EPS = 0.18; % inverse aspect ratio +GRADB = 1.0; % Magnetic gradient +CURVB = 1.0; % Magnetic curvature %% TIME PARAMETERS -TMAX = 90; % Maximal time unit -DT = 2e-2; % Time step +TMAX = 10; % Maximal time unit +DT = 5e-3; % Time step SPS0D = 1; % Sampling per time unit for profiler SPS2D = 1; % Sampling per time unit for 2D arrays -SPS3D = 1/2; % Sampling per time unit for 3D arrays +SPS3D = 5; % Sampling per time unit for 3D arrays SPS5D = 1/200; % Sampling per time unit for 5D arrays SPSCP = 0; % Sampling per time unit for checkpoints/10 JOB2LOAD= -1; %% OPTIONS AND NAMING % Collision operator % (0 : L.Bernstein, 1 : Dougherty, 2: Sugama, 3 : Pitch angle ; 4 : Coulomb; +/- for GK/DK) CO = 1; CLOS = 0; % Closure model (0: =0 truncation) NL_CLOS = 0; % nonlinear closure model (-2: nmax = jmax, -1: nmax = jmax-j, >=0 : nmax = NL_CLOS) -% SIMID = 'Linear_Device'; % Name of the simulation -SIMID = 'simulation_A'; % Name of the simulation +SIMID = 'fluxtube_salphaB_s0'; % Name of the simulation +% SIMID = 'simulation_A'; % Name of the simulation % SIMID = ['v3.0_P_',num2str(P),'_J_',num2str(J)]; % Name of the simulation -NON_LIN = 1; % activate non-linearity (is cancelled if KXEQ0 = 1) +NON_LIN = 0; % activate non-linearity (is cancelled if KXEQ0 = 1) % INIT options -INIT_ZF = 0; ZF_AMP = 0.0; +INIT_PHI= 1; % Start simulation with a noisy phi (0= noisy moments 00) +INIT_ZF = 0; ZF_AMP = 0.0; INIT_BLOB = 0; WIPE_TURB = 0; WIPE_ZF = 0; %% OUTPUTS W_DOUBLE = 1; W_GAMMA = 1; W_HF = 1; W_PHI = 1; W_NA00 = 1; W_DENS = 1; W_TEMP = 1; W_NAPJ = 1; W_SAPJ = 0; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% unused PMAXE = P; % Highest electron Hermite polynomial degree JMAXE = J; % Highest '' Laguerre '' PMAXI = P; % Highest ion Hermite polynomial degree JMAXI = J; % Highest '' Laguerre '' KERN = 0; % Kernel model (0 : GK) KX0KH = 0; A0KH = 0; % Background phi mode to drive Ray-Tay inst. KPAR = 0.0; % Parellel wave vector component LAMBDAD = 0.0; -kmax = Nx*pi/L;% Highest fourier mode +kmax = NX*pi/LX;% Highest fourier mode HD_CO = 0.5; % Hyper diffusivity cutoff ratio MU = NU_HYP/(HD_CO*kmax)^4; % Hyperdiffusivity coefficient NOISE0 = 1.0e-5; BCKGD0 = 0.0; % Init background TAU = 1.0; % e/i temperature ratio -INIT_PHI= 1; % Start simulation with a noisy phi and moments MU_P = 0.0; % Hermite hyperdiffusivity -mu_p*(d/dvpar)^4 f MU_J = 0.0; % Laguerre hyperdiffusivity -mu_j*(d/dvperp)^4 f %% Setup and file management setup system('rm fort*.90'); outfile = [BASIC.RESDIR,'out.txt']; disp(outfile); diff --git a/wk/plot_phi_ballooning.m b/wk/plot_phi_ballooning.m index 47bd05e..678cd3b 100644 --- a/wk/plot_phi_ballooning.m +++ b/wk/plot_phi_ballooning.m @@ -1,68 +1,46 @@ [~,it] = min(abs(Ts3D - time_2_plot)); phi_real=(real(PHI(:,:,:,it))); phi_imag=(imag(PHI(:,:,:,it))); % Apply baollooning tranform for iky=2 dims = size(phi_real); - phib_real = zeros( dims(1)*Nz ,1); + phib_real = zeros( dims(1)*dims(3) ,1); phib_imag= phib_real; b_angle = phib_real; - midpoint = floor((dims(1)*Nz )/2)+1; + midpoint = floor((dims(1)*dims(3) )/2)+1; for ip =1: dims(1) - start_ = (ip -1)*Nz +1; - end_ = ip*Nz; + start_ = (ip -1)*dims(3) +1; + end_ = ip*dims(3); phib_real(start_:end_) = phi_real(ip,iky,:); phib_imag(start_:end_) = phi_imag(ip,iky, :); end % Define ballooning angle Nkx = numel(kx)-1; coordz = z; idx = -Nkx:1:Nkx; for ip =1: dims(1) - for iz=1:Nz - ii = Nz*(ip -1) + iz; + for iz=1:dims(3) + ii = dims(3)*(ip -1) + iz; b_angle(ii) =coordz(iz) + 2*pi*idx(ip); end end % normalize real and imaginary parts at chi =0 [~,idxLFS] = min(abs(b_angle -0)); phib = phib_real(:) + 1i * phib_imag(:); % Normalize to the outermid plane - phib_norm = phib(:);% / phib( idxLFS) ; - phib_real_norm(:) = real( phib_norm);%phib_real(:)/phib_real(idxLFS); - phib_imag_norm(:) = imag( phib_norm);%phib_imag(:)/ phib_imag(idxLFS); + phib_norm = phib;% / phib( idxLFS) ; + phib_real_norm = real( phib_norm);%phib_real(:)/phib_real(idxLFS); + phib_imag_norm = imag( phib_norm);%phib_imag(:)/ phib_imag(idxLFS); figure; hold all; plot(b_angle/pi, phib_real_norm,'-b'); plot(b_angle/pi, phib_imag_norm ,'-r'); plot(b_angle/pi, sqrt(phib_real_norm .^2 + phib_imag_norm.^2),'-k'); legend('real','imag','norm') xlabel('$\chi / \pi$') ylabel('$\phi_B (\chi)$'); title(['HeLaZ(-) molix(o) benchmark, t=',num2str(Ts3D(it))]); -% title(['HeLaZ,$(P,J) =(',num2str(PMAXI),', ', num2str(JMAXI),'$), $\nu =',num2str(NU),... -% '$, $\epsilon = ',num2str(eps),'$, $k_y = ', num2str(ky( iky)),'$, $q =',num2str(q0),'$, $s = ', num2str(shear),'$, $R_N = ', ... -% num2str(K_N),'$, $R_{T_i} = ', num2str(K_T),'$, $N_z =',num2str(Nz),'$']); - %set(gca,'Yscale','log') - % - -% %Check symmetry of the mode at the outter mid plane -% figure; hold all; -% right = phib_real(midpoint+1:end); -% left = fliplr(phib_real(1:midpoint-1)'); -% up_down_symm = right(1:end) - left(1:end-1)'; -% %plot(b_angle(midpoint+1:end)/pi,phib_real(midpoint+1:end),'-xb'); -% plot(b_angle(midpoint+1:end)/pi,up_down_symm ,'-xb'); - %plot(abs(b_angle(1:midpoint-1))/pi,phib_real(1:midpoint-1),'-xb'); - % - % - % figure; hold all - % plot(b_angle/pi, phib_imag.^2 + phib_real.^2 ,'xk'); - % %set(gca,'Yscale','log') - % xlabel('$\chi / \pi$') - % ylabel('$\phi_B (\chi)$'); - % title(['$(P,J) =(',num2str(pmax),', ', num2str(jmax),'$), $\nu =',num2str(nu),'$, $\epsilon = ',num2str(epsilon),'$, $q =',num2str(safety_fac),'$, $s = ', num2str(shear),'$, $k_y =',num2str(ky),'$']); end diff --git a/wk/shearless_linear_fluxtube.m b/wk/shearless_linear_fluxtube.m index 4fa96d0..8700441 100644 --- a/wk/shearless_linear_fluxtube.m +++ b/wk/shearless_linear_fluxtube.m @@ -1,109 +1,110 @@ RUN = 1; % To run or just to load addpath(genpath('../matlab')) % ... add default_plots_options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Set Up parameters CLUSTER.TIME = '99:00:00'; % allocation time hh:mm:ss %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% PHYSICAL PARAMETERS NU = 0.0; % Collision frequency TAU = 1.0; % e/i temperature ratio K_N = 2.22; % Density gradient drive K_T = 6.0; % Temperature ''' SIGMA_E = 0.05196; % mass ratio sqrt(m_a/m_i) (correct = 0.0233380) +KIN_E = 1; % Kinetic (1) or adiabatic (0) electron model %% GRID PARAMETERS -Nx = 1; % real space x-gridpoints -Ny = 2; % '' y-gridpoints -Lx = 0; % Size of the squared frequency domain -Ly = 2*pi/0.25; % Size of the squared frequency domain -Nz = 24; % number of perpendicular planes (parallel grid) -q0 = 2.7; % safety factor -shear = 0.0; % magnetic shear -eps = 0.18; % inverse aspect ratio +NX = 1; % real space x-gridpoints +NY = 2; % '' y-gridpoints +LX = 0; % Size of the squared frequency domain +LY = 2*pi/0.25; % Size of the squared frequency domain +NZ = 24; % number of perpendicular planes (parallel grid) +Q0 = 2.7; % safety factor +SHEAR = 0.0; % magnetic shear +EPS = 0.18; % inverse aspect ratio %% TIME PARMETERS TMAX = 10; % Maximal time unit DT = 1e-3; % Time step SPS0D = 1; % Sampling per time unit for 2D arrays SPS2D = 0; % Sampling per time unit for 2D arrays SPS3D = 10; % Sampling per time unit for 2D arrays SPS5D = 1/100; % Sampling per time unit for 5D arrays SPSCP = 0; % Sampling per time unit for checkpoints JOB2LOAD= -1; %% OPTIONS SIMID = 'shearless_fluxtube'; % Name of the simulation % Collision operator % (0 : L.Bernstein, 1 : Dougherty, 2: Sugama, 3 : Pitch angle, 4 : Full Couloumb ; +/- for GK/DK) CO = 1; INIT_ZF = 0; ZF_AMP = 0.0; CLOS = 0; % Closure model (0: =0 truncation, 1: gyrofluid closure (p+2j<=Pmax)) NL_CLOS =-1; % nonlinear closure model (-2:nmax=jmax; -1:nmax=jmax-j; >=0:nmax=NL_CLOS) KERN = 0; % Kernel model (0 : GK) %% OUTPUTS W_DOUBLE = 0; W_GAMMA = 1; W_HF = 1; W_PHI = 1; W_NA00 = 1; W_DENS = 1; W_TEMP = 1; W_NAPJ = 1; W_SAPJ = 0; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % unused HD_CO = 0.5; % Hyper diffusivity cutoff ratio kmax = Nx*pi/Lx;% Highest fourier mode NU_HYP = 0.0; % Hyperdiffusivity coefficient MU = NU_HYP/(HD_CO*kmax)^4; % Hyperdiffusivity coefficient MU_P = 0.0; % Hermite hyperdiffusivity -mu_p*(d/dvpar)^4 f MU_J = 0.0; % Laguerre hyperdiffusivity -mu_j*(d/dvperp)^4 f K_E = 0.00; % Electrostat ''' GRADB = 1.0; CURVB = 1.0; INIT_BLOB = 0; WIPE_TURB = 0; WIPE_ZF = 0; INIT_PHI= 0; NOISE0 = 0.0e-4; % Init noise amplitude BCKGD0 = 1.0e-4; % Init background LAMBDAD = 0.0; KXEQ0 = 0; % put kx = 0 NON_LIN = 0; % activate non-linearity (is cancelled if KXEQ0 = 1) %% PARAMETER SCANS if 1 %% Parameter scan over PJ % PA = [2 4]; % JA = [1 2]; PA = [4]; JA = [2]; DTA= DT*ones(size(JA));%./sqrt(JA); % DTA= DT; mup_ = MU_P; muj_ = MU_J; Nparam = numel(PA); param_name = 'PJ'; gamma_Ni00 = zeros(Nparam,floor(Nx/2)+1); gamma_Nipj = zeros(Nparam,floor(Nx/2)+1); gamma_phi = zeros(Nparam,floor(Nx/2)+1); % Ni00_ST = zeros(Nparam,floor(Nx/2)+1,TMAX/SPS3D); % PHI_ST = zeros(Nparam,floor(Nx/2)+1,TMAX/SPS3D); for i = 1:Nparam % Change scan parameter PMAXE = PA(i); PMAXI = PA(i); JMAXE = JA(i); JMAXI = JA(i); DT = DTA(i); setup % system(['rm fort*.90']); % Run linear simulation if RUN - system(['cd ../results/',SIMID,'/',PARAMS,'/; ./../../../bin/helaz 0 > out.txt; cd ../../../wk']) + system(['cd ../results/',SIMID,'/',PARAMS,'/; ./../../../bin/helaz 0; cd ../../../wk']) end % Load and process results %% filename = ['../results/',SIMID,'/',PARAMS,'/outputs_00.h5']; load_results end end if 0 %% Trajectories of some modes figure; for i = 1:10:Nx/2+1 semilogy(Ts3D,squeeze(abs(Ne00(i,2,1,:))),'DisplayName',['k=',num2str(kx(i))]); hold on; end end \ No newline at end of file