Skip to content

Instantly share code, notes, and snippets.

@rkube

rkube/diff

Created April 22, 2022 19:01
Show Gist options
  • Save rkube/e9fb906fe91161c35aedfaa59a593538 to your computer and use it in GitHub Desktop.
Save rkube/e9fb906fe91161c35aedfaa59a593538 to your computer and use it in GitHub Desktop.
Download ZIP
xgc_diff_tracerdiag
Raw
diff
diff --git a/CMake/FindKokkos.cmake b/CMake/FindKokkos.cmake
index 3a62d58c..dd0f0e6a 100644
--- a/CMake/FindKokkos.cmake
+++ b/CMake/FindKokkos.cmake
@@ -1,18 +1,10 @@
find_package(Kokkos CONFIG)
if(Kokkos_FOUND)
- if(TARGET kokkos)
- # Kokkos' imported target doesn't give us its include path,
- # so we add it here.
- get_target_property(Kokkos_LIBRARY kokkos LOCATION)
- get_filename_component(Kokkos_LIBRARY_DIR ${Kokkos_LIBRARY} DIRECTORY)
- get_filename_component(Kokkos_INSTALL_DIR ${Kokkos_LIBRARY_DIR} DIRECTORY)
- find_path(Kokkos_INCLUDE_DIR NAMES KokkosCore_config.h PATHS ${Kokkos_INSTALL_DIR}/include)
- set_target_properties(kokkos PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${Kokkos_INCLUDE_DIR}")
- elseif(TARGET Kokkos::kokkos)
- # Create interface library for the old un-namespaced name.
- add_library(kokkos INTERFACE)
- target_link_libraries(kokkos INTERFACE Kokkos::kokkos)
- else()
- message(SEND_ERROR "Found Kokkos but could not determine target name to reference")
- endif()
+ # Kokkos' imported target doesn't give us its include path,
+ # so we add it here.
+ get_target_property(Kokkos_LIBRARY kokkos LOCATION)
+ get_filename_component(Kokkos_LIBRARY_DIR ${Kokkos_LIBRARY} DIRECTORY)
+ get_filename_component(Kokkos_INSTALL_DIR ${Kokkos_LIBRARY_DIR} DIRECTORY)
+ find_path(Kokkos_INCLUDE_DIR NAMES KokkosCore_config.h PATHS ${Kokkos_INSTALL_DIR}/include)
+ set_target_properties(kokkos PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${Kokkos_INCLUDE_DIR}")
endif()
diff --git a/CMake/find_dependencies_cori_knl.cmake b/CMake/find_dependencies_cori_knl.cmake
index fe538e6b..e6c9a439 100644
--- a/CMake/find_dependencies_cori_knl.cmake
+++ b/CMake/find_dependencies_cori_knl.cmake
@@ -1,10 +1,8 @@
set(USER_LIB_DIR "/project/projectdirs/m499/Software")
set(ADIOS1_ROOT "${USER_LIB_DIR}/adios/DEFAULT/cori_knl/DEFAULT")
-set(PETSC_ROOT "${USER_LIB_DIR}/petsc/DEFAULT/cori_knl/DEFAULT")
-set(Kokkos_ROOT "${USER_LIB_DIR}/kokkos/DEFAULT/cori_knl/DEFAULT")
-set(Cabana_ROOT "${USER_LIB_DIR}/Cabana/DEFAULT/cori_knl/DEFAULT")
-set(FFTW3_ROOT "/opt/cray/pe/fftw/default/mic_knl")
+
+set(PETSC_ROOT "/global/common/cori/software/petsc/3.7.4-64-sep2017/hsw")
find_package(FFTW3 REQUIRED)
find_package(PETSC REQUIRED)
@@ -18,7 +16,12 @@ foreach(lib_dir IN LISTS CRAY_LD_LIBRARY_PATH_LIST)
endforeach()
set(USE_SYSTEM_CAMTIMERS ON CACHE BOOL "Use system camtimers")
-set(CAMTIMERS_ROOT "${USER_LIB_DIR}/camtimers/DEFAULT/cori_knl/DEFAULT")
+set(CAMTIMERS_DIR "${USER_LIB_DIR}/camtimers/DEFAULT/cori_knl/DEFAULT")
+set(CAMTIMERS_LIB "${CAMTIMERS_DIR}/lib/libtimers.a")
+set(CAMTIMERS_INCLUDE "${CAMTIMERS_DIR}/include")
set(USE_SYSTEM_PSPLINE ON CACHE BOOL "Use system pspline")
-set(PSPLINE_ROOT "${USER_LIB_DIR}/pspline/DEFAULT/cori_knl/DEFAULT")
+set(PSPLINE_DIR "${USER_LIB_DIR}/pspline/DEFAULT/cori_knl/DEFAULT")
+set(PSPLINE_LIB "${PSPLINE_DIR}/lib/libpspline.a")
+set(PSPLINE_INCLUDE "${PSPLINE_DIR}/include")
+set(PSPLINE_MOD "${PSPLINE_DIR}/include")
diff --git a/CMakeLists.txt b/CMakeLists.txt
index d742fe2d..721201c9 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -15,7 +15,7 @@ if (BUILD_DEPENDENCIES)
return()
endif()
-enable_language(C CXX Fortran)
+enable_language(C Fortran)
if (CMAKE_Fortran_COMPILER_ID STREQUAL GNU)
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-ffree-line-length-none>")
@@ -112,13 +112,14 @@ else()
target_link_libraries(global_settings INTERFACE OpenMP::OpenMP_CXX)
endif()
+# XGC_TYPES means vanilla vs. cpp vs. gpu.
+enable_language(CXX)
# nvcc_wrapper doesn't recognize PGI's --c++11 flag.
if (CMAKE_CXX_COMPILER MATCHES "nvcc_wrapper" AND CMAKE_CXX_COMPILER_ID MATCHES "PGI")
target_compile_options(global_settings INTERFACE
$<$<COMPILE_LANGUAGE:CXX>:--std=c++11>)
endif()
-# XGC_TYPES means vanilla vs. cpp vs. gpu.
# Flavors (XGC1,XGCa) and Types (cpu,gpu)
set(FLAVORS "XGC1" "XGCa")
set(XGC_TYPES "cpu")
@@ -423,24 +424,17 @@ foreach (flavor IN LISTS FLAVORS)
endif()
write_build_info(${exe})
- # Link with Fortran if using PGI or Intel.
- if (CMAKE_CXX_COMPILER_ID MATCHES "PGI" OR CMAKE_CXX_COMPILER_ID MATCHES "Intel")
+ # Link with Fortran if using PGI
+ if (CMAKE_CXX_COMPILER_ID MATCHES "PGI")
set_target_properties(${exe} PROPERTIES LINKER_LANGUAGE Fortran)
endif()
endforeach()
endforeach()
-if (BUILD_TESTING)
- find_package(GTest)
- if (NOT GTest_FOUND)
- message(WARNING "Disabling testing since GTest could not be found")
- set(BUILD_TESTING OFF)
- endif()
-endif()
-
if (BUILD_TESTING)
# Tests
# Locate GTest
+ find_package(GTest REQUIRED)
include_directories(${GTEST_INCLUDE_DIR})
# Use the CMake GoogleTest module
diff --git a/README.md b/README.md
index 14e430a2..774797c1 100644
--- a/README.md
+++ b/README.md
@@ -20,27 +20,18 @@ There several versions of XGC for different purposes:
3. XGCs is a development version of XGC that supports 3D magnetic equilibrium field. This version is suitable for simulation of neoclassical and turbulent transport in stellarator geometry.
-## Documentation
-
-[See here](https://xgc.pppl.gov/html/index.html) for all XGC documentation.
-
-
## Building XGC
-[See here](https://xgc.pppl.gov/html/building_xgc.html) for instructions on how to build XGC.
-
-
-
-## Example Cases
-
-[See here](https://github.com/PrincetonUniversity/XGC-Examples.git) for XGC example setups.
+[See here](Docs/building.md) for instructions on how to build XGC.
## Information for XGC developers
-Guidelines for contributing code to XGC and a documentation of the Git workflow developers are expected to follow can be found [here](https://xgc.pppl.gov/html/git_intro.html). Please read these instructions carefully before starting to use the XGC repositories.
+Guidelines for contributing code to XGC and a documentation of the Git workflow developers are expected to follow can be found [here](https://docs.google.com/document/d/1iae_8GZjgCAARqhvd8ju-toGOQXFwVLYUNuirR8k52w/edit?usp=sharing). Please read these instructions carefully before starting to use the XGC repositories.
+
+Need to make changes to XGC's build system? [Start here.](Docs/buildsystem.md)
diff --git a/XGC1/charge.F90 b/XGC1/charge.F90
index 720b0494..a40cd304 100644
--- a/XGC1/charge.F90
+++ b/XGC1/charge.F90
@@ -71,10 +71,6 @@ subroutine chargee_scatter(grid,psn,sp)
!
integer :: jth, iphi
real (8), external :: psi_interpol
- ! debugging removed particles
- integer :: n_removed_particles
-
- n_removed_particles = 0
#ifdef CHARGEE_SCATTER_UNIT_READ
! if (istep==3) then ! Choose which step of the example you'd like the unit test to come from
@@ -106,7 +102,7 @@ subroutine chargee_scatter(grid,psn,sp)
call t_startf("CHARGEE_SCATTER_LOOP1")
!$OMP PARALLEL DEFAULT(NONE) &
- !$OMP SHARED(sp,grid,sml_deltaf_elec,sml_00_xz_up,eq_x_z, n_removed_particles), &
+ !$OMP SHARED(sp,grid,sml_deltaf_elec,sml_00_xz_up,eq_x_z), &
#ifdef CHARGE_SCATTER_USE_ATOMIC
!$omp shared(den,den00), &
#else
@@ -174,16 +170,13 @@ subroutine chargee_scatter(grid,psn,sp)
!eliminate particle
call remove_particle(sp,i,-1,ith) ! no need due to sheath_calculation
- n_removed_particles = n_removed_particles + 1
endif
enddo ! end of particle-thread loop
!$OMP END PARALLEL
- if (n_removed_particles .gt. 0) then
- print *, "subroutine chargee_scatter: n_removed_particles = ", n_removed_particles
- endif
+
call t_stopf("CHARGEE_SCATTER_LOOP1")
call t_startf("CHARGEE_SCATTER_LOOP2")
@@ -319,9 +312,6 @@ subroutine chargee_search_index_local(grid,psn,sp,i_beg,i_end,ith)
real (8) :: phi_mid, x(2), phi, mu, rho, xff(2), p(3)
real (kind=8), external :: gyro_radius
- ! for debugging
- integer :: n_removed_particles
- n_removed_particles = 0
particleLoop: do i=i_beg,i_end
if(sp%ptl(i)%gid>0) then
@@ -354,7 +344,6 @@ subroutine chargee_search_index_local(grid,psn,sp,i_beg,i_end,ith)
if(itr .lt. 0) then
if(sml_sheath_mode==0 .or. sml_gstep <= 0 ) then
call remove_particle(sp,i,-1,ith)
- n_removed_particles = n_removed_particles + 1
else
!!$omp critical
call sheath_calculation(grid,sp,i,0,itr,p,ith,sml_sheath_mode)
@@ -366,9 +355,6 @@ subroutine chargee_search_index_local(grid,psn,sp,i_beg,i_end,ith)
sp%p_save(:,i)=p
endif
end do particleLoop
- if (n_removed_particles .gt. 0) then
- print *, 'subroutine chargee_search_index_local: n_removed_particles = ', n_removed_particles
- endif
end subroutine chargee_search_index_local
#else
@@ -381,7 +367,6 @@ subroutine chargee_search_index(grid,psn,sp)
use sheath_module
use omp_module, only: split_indices
use perf_monitor
- use diag_module, only: diag_fullf_turb_period
implicit none
type(grid_type):: grid
type(psn_type) :: psn
@@ -393,16 +378,12 @@ subroutine chargee_search_index(grid,psn,sp)
real (8) :: p(3)
integer :: itr, ip
real (kind=8), external :: gyro_radius
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
!phi_mid=0.5D0*(grid%phimin+grid%phimax)
call split_indices(sp%num, sml_nthreads, i_beg, i_end)
!$OMP PARALLEL DO &
-!$OMP SHARED( n_removed_particles ), &
!$OMP PRIVATE( ITH, I, PHI, PHI_MID, &
!$OMP X, MU, RHO, XFF, &
!$OMP P, ITR, IP )
@@ -428,9 +409,8 @@ subroutine chargee_search_index(grid,psn,sp)
!remove particle or sheath calculation
if(itr<0) then
- if(sml_sheath_mode==0 .or. sml_gstep <= 0 .or. diag_fullf_turb_period > 0) then
+ if(sml_sheath_mode==0 .or. sml_gstep <= 0 ) then
call remove_particle(sp,i,-1,ith)
- n_removed_particles = n_removed_particles + 1
else
!!$omp critical
call sheath_calculation(grid,sp,i,0,itr,p,ith,sml_sheath_mode)
@@ -448,9 +428,6 @@ subroutine chargee_search_index(grid,psn,sp)
enddo
call t_stopf("CHARGEE_SRCHLOOP")
enddo
- if(n_removed_particles .gt. 0) then
- print *, "subroutine chargee_search_index: n_removed_particles = ", n_removed_particles
- endif
end subroutine chargee_search_index
#endif
@@ -1303,9 +1280,6 @@ subroutine chargei_scatter(grid,psn,sp)
integer :: imu0,imu1
real (8) :: psi,Ti,Bx,mun,wmu(4),mu,x0(2),x1(2),rho0,rho1,rhoth,rho_
#endif
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
#ifdef CHARGEI_SCATTER_UNIT_READ
! if (istep==3) then ! Choose which step of the example you'd like the unit test to come from
@@ -1373,9 +1347,9 @@ subroutine chargei_scatter(grid,psn,sp)
!---> CHARGE_SCATTER_USE_ATOMIC
#endif
#ifdef NEWGYROMATRIX
- !$OMP SHARED(sp,grid,sml_deltaf,inv_drho,dx_unit,sml_00_xz_up,eq_x_z,ptl_charge,ptl_mass,eq_tempi, n_removed_particles),&
+ !$OMP SHARED(sp,grid,sml_deltaf,inv_drho,dx_unit,sml_00_xz_up,eq_x_z,ptl_charge,ptl_mass,eq_tempi),&
#else
- !$OMP SHARED(sp,grid,sml_deltaf,inv_drho,dx_unit,sml_00_xz_up,eq_x_z,ptl_charge,ptl_mass, n_removed_particles),&
+ !$OMP SHARED(sp,grid,sml_deltaf,inv_drho,dx_unit,sml_00_xz_up,eq_x_z,ptl_charge,ptl_mass),&
#endif
!$OMP PRIVATE( ITH, I, IRHO, J, NODE, UPAR, B, &
!$OMP PHI, WPHI, PARTICLE_WEIGHT, RHO, RHON, WRHO, WP, &
@@ -1535,7 +1509,6 @@ subroutine chargei_scatter(grid,psn,sp)
!eliminate particle
call remove_particle(sp,i,-1,ith) ! no need due to sheath_calculation
- n_removed_particles = n_removed_particles + 1
endif
@@ -1582,9 +1555,6 @@ subroutine chargei_scatter(grid,psn,sp)
call chargei_scatter_write_unit_state(grid,psn,sp,.false.)
! endif
#endif
-if (n_removed_particles .gt. 0) then
- print *, "subroutine chargei_scatter: n_removed_particles = ", n_removed_particles
-endif
end subroutine chargei_scatter
@@ -1610,16 +1580,12 @@ subroutine chargei_search_index(grid,psn,sp)
real (8) :: p(3)
integer :: itr, ip
real (kind=8), external :: gyro_radius
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
phi_mid=0.5D0*(grid%phimin+grid%phimax)
call split_indices(sp%num, sml_nthreads, i_beg, i_end)
!$OMP PARALLEL DO &
-!$OMP SHARED (n_removed_particles), &
!$OMP PRIVATE( ITH, I, &
!$OMP X, PHI, MU, RHO, XFF, &
!$OMP P, ITR, IP )
@@ -1646,7 +1612,6 @@ subroutine chargei_search_index(grid,psn,sp)
if(itr<0) then
if(sml_sheath_mode==0 .or. sml_gstep <= 0 ) then
call remove_particle(sp,i,-1,ith)
- n_removed_particles = n_removed_particles + 1
else
!!$omp critical
call sheath_calculation(grid,sp,i,1,itr,p,ith,sml_sheath_mode)
@@ -1665,9 +1630,6 @@ subroutine chargei_search_index(grid,psn,sp)
enddo
call t_stopf("CHARGEI_SRCHLOOP")
enddo
- if (n_removed_particles .gt. 0) then
- print *, "subroutine chargei_search_index: n_removed_particles = ", n_removed_particles
- endif
end subroutine chargei_search_index
diff --git a/XGC1/diag_fullf.F90 b/XGC1/diag_fullf.F90
deleted file mode 100644
index 73383006..00000000
--- a/XGC1/diag_fullf.F90
+++ /dev/null
@@ -1,910 +0,0 @@
-!***************************************************************
-! routines for the tracer full-f diagnostic
-!***************************************************************
-#ifdef PUSHE_KERNEL
-#include "adios_stub_macro.h"
-#else
-#include "adios_macro.h"
-#endif
-
-!diagnostic to calculate Lagrangian turbulence characteristics using a full-f
-!diagnostic tracing new full-f markers every diag_fullf_period.
-!RMC 2019/08
-subroutine diag_fullf_turb(grid,psn,shift_opt,e_shift_opt)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module
- use f0_module
- use omp_module , only : split_indices
- use push_module, only : push
- use pol_decomp_module, only : f0_inode1,f0_inode2,f0_inode1_save,f0_inode2_save
- use shift_module, only : shift_sp
- use perf_monitor
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- integer :: it, ith, i, istep, ipc, isp
- integer :: ncycle
- type(species_type) :: spfullf(0:ptl_nsp_max) !ions only
- real (kind=8) :: phase0(ptl_nphase,diag_fullf_turb_ptl_num)
- integer :: i_beg(sml_nthreads), i_end(sml_nthreads)
- integer :: err
- integer, optional :: shift_opt(num_shift_ie_opts), e_shift_opt(num_shift_ie_opts)
- character (len=1024) :: file_suffix
- logical :: diag_on
-
-#ifdef DIAG_FULLF
- if ((diag_fullf_turb_period.gt.0).and.(sml_gstep.le.diag_fullf_turb_start)) return
-
- !if not at diag_fullf_period, just save data
- it = mod(sml_gstep,diag_fullf_turb_period)
- if(it>0) then
- psn%pot_rho_ff_save(it,:,:,:) = psn%pot_rho_ff(:,:,:)
- psn%E_rho_ff_save(it,:,:,:,:) = psn%E_rho_ff(:,:,:,:)
- if(it==1) then
- f0_f_save = f0_f
- f0_inode1_save=f0_inode1
- f0_inode2_save=f0_inode2
- f0_T_ev_save=f0_T_ev
- f0_B_B0_save=f0_B_B0
- endif
- return
- endif
-
- !TODO: Don't hardcode diag_fullf_in/outpsi, add to setup
- !TODO: Change from core
- diag_fullf_inpsi=0.93*eq_x_psi !0.2
- diag_fullf_outpsi=1.02*eq_x_psi !0.3
-
-
- !print *,'Start diag_fullf_turb particle creation sml_mype,f0_inode1_save,f0_inode2_save ',sml_mype, f0_inode1_save,f0_inode2_save
- !if at diag_fullf_turb_period, run the fullf_turb diagnostic
- call create_fullf_markers(grid,psn,spfullf)
- !call MPI_BARRIER(sml_comm,err)
- if (spfullf(1)%num>0) print *,'Finished diag_fullf_turb particle creation ',sml_mype
-
- !TODO: need to save intial phase variables here
- !!!!!!!!!!!populate phase0, since won't populate in ipc=1 call
- do isp=ptl_isp,ptl_nsp
- call split_indices(spfullf(isp)%num, sml_nthreads, i_beg, i_end)
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I )
- do ith=1,sml_nthreads
- do i=i_beg(ith), i_end(ith)
- spfullf(isp)%phase0(:,i)=spfullf(isp)%ptl(i)%ph
- enddo
- enddo
- enddo
-
- if (spfullf(1)%num>0) print *,'#1: Start shift_opt storage ',sml_mype
- !hack to get shift_opts
- spfullf(1)%shift_opt(:) = shift_opt(:)
- if (sml_electron_on) then
- spfullf(0)%shift_opt(:) = e_shift_opt(:)
- endif
-
- call t_startf("DIAG_FULLF_TURB_SHIFT")
- if (spfullf(1)%num>0) print *,'#1: Start shift_sp ',sml_mype
- !I think I need this initially, but not sure
- call shift_sp(grid,psn,spfullf(1))
- call chargei_search_index(grid,psn,spfullf(1)) ! sub-subroutine
- if (sml_electron_on) then
- call shift_sp(grid,psn,spfullf(0))
- !to update non sp%ptl (e.g. sp%tr_save)
- call chargee_search_index(grid,psn,spfullf(0)) ! sub-subroutine
- endif
- call t_stopf("DIAG_FULLF_TURB_SHIFT")
-
- if (spfullf(1)%num>0) print *,'Start initial diag_particle ',sml_mype
- !save initial particle phase
- !TODO: just add 1000 to sml_gstep for now. Need a different solution though.
- call t_startf("DIAG_FULLF_TURB_DIAG_PARTICLE")
- call diag_particle2(grid,psn,spfullf,sml_gstep,"diag0")
- call t_stopf("DIAG_FULLF_TURB_DIAG_PARTICLE")
-
- if (spfullf(1)%num>0) print *,'Finished initial diag_particle ',sml_mype
-
- !if (spfullf(1)%num>0) print *,'Start diag_fullf_turb particle push ',sml_mype
- !push forward diag_fullf_period steps
- do it=1,diag_fullf_turb_period
- istep=it !this shouldnt matter
- ipc=2 !fix, for doing the full push step (dont need partial to get fields)
-
- !!!!!!!!!!!populate phase0, since won't populate in ipc=1 call
- do isp=ptl_isp,ptl_nsp
- call split_indices(spfullf(isp)%num, sml_nthreads, i_beg, i_end)
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I )
- do ith=1,sml_nthreads
- do i=i_beg(ith), i_end(ith)
- spfullf(isp)%phase0(:,i)=spfullf(isp)%ptl(i)%ph
- enddo
- enddo
- enddo
-
- !load the correct field for this timestep
- psn%pot_rho_ff(:,:,:) = psn%pot_rho_ff_save(it,:,:,:)
- psn%E_rho_ff(:,:,:,:) = psn%E_rho_ff_save(it,:,:,:,:)
-
- call t_startf("DIAG_FULLF_TURB_PUSH")
- !if (spfullf(1)%num>0) print *,'pushing ',it,sml_mype
- !if (spfullf(1)%num>0) print *,'pushing ',it,sml_mype
- if(sml_electron_on) then
- !RMC 2020/07/10 - Pretty sure we dont need this, since ipc==2 for diag_main_loop
- !call save_or_load_electron_phase(spall(0),ipc) ! Also f0 is restored.
- ncycle=sml_ncycle_half*2 !always ipc=2
-
-
-!RMC 2020/07/10 - Do I need this? Dont think so, but not sure, if we already get E-field sent from XGC1 main
-! #ifdef XGC1
-! !##################################################################
-! !electron push with sub-cycling
-! call t_startf("GAT_FIELD_INFO")
-! call gather_field_info(grid,psn) ! gather other plane E-field info
-! call t_stopf("GAT_FIELD_INFO")
-! ! gather_field_info should be block here
-! !#################################################################
-! #endif
-
- diag_on=.false.
- call pushe(istep,ncycle,grid,psn,spfullf(0),diag_on)
- endif !sml_electron_on
- call push(istep,ipc,grid,psn,spfullf(1),spfullf(1)%phase0,spfullf(1)%ptl,.false.)
- call t_stopf("DIAG_FULLF_TURB_PUSH")
-
- call t_startf("DIAG_FULLF_TURB_SHIFT")
- call shift_sp(grid,psn,spfullf(1))
- call chargei_search_index(grid,psn,spfullf(1)) ! sub-subroutine
- if (sml_electron_on) then
- call shift_sp(grid,psn,spfullf(0))
- call chargee_search_index(grid,psn,spfullf(0)) ! sub-subroutine
- endif !sml_electron_on
- call t_stopf("DIAG_FULLF_TURB_SHIFT")
-
- !save data
- print *,'it,ptl_num,sml_mype',it,spfullf(1)%num,sml_mype
- call t_startf("DIAG_FULLF_TURB_DIAG_PARTICLE")
- write (file_suffix, "(A6,I0.3)") "diag1_",mod(sml_gstep, diag_fullf_turb_period) - 1
- call diag_particle2(grid,psn,spfullf,it,file_suffix)
- call t_stopf("DIAG_FULLF_TURB_DIAG_PARTICLE")
- enddo !it=1,diag_fullf_turb_period
- !if (spfullf(1)%num>0) print *,'Finish diag_fullf_turb particle push ',sml_mype
-#else
- print*, "ERROR!! subroutine diag_fullf_turb not implemented"
-#endif
-
-
-end subroutine diag_fullf_turb
-
-
-!TODO: Should probably put these into a separate module, or something
- subroutine create_fullf_markers(grid,psn,spfullf)
- use f0_module
- use grid_class
- use psn_class
- use sml_module, only: sml_gstep,sml_marker_den2, sml_nlarmor, sml_electron_on, sml_totalpe
- use ptl_module
- use diag_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- type(species_type), intent(inout) :: spfullf(0:ptl_nsp_max) !ions only
- integer :: sml_ptl_isp, maxnum, num
- integer :: node, Nnodesinf0, ioff, i, isp
-
-#ifdef DIAG_FULLF
- !check that this process f0_inode1 to f0_inode2 range IS inside this inpsi - outpsi range
- if (sml_mype .eq. 0) print *,'Starting Nnodesinf0'
- Nnodesinf0 = 0
- do node=f0_inode1,f0_inode2
- if (grid%psi(node) .ge. diag_fullf_inpsi .and. grid%psi(node) .le. diag_fullf_outpsi) then
- Nnodesinf0 = Nnodesinf0 + 1
- endif
- enddo
- print *,'Finished Nnodesinf0',sml_mype,Nnodesinf0
-
- !TODO: Implement necesary f0_f_save communication for actual in-situ analysis case
- if(Nnodesinf0 .gt. 0) then
- num = int(diag_fullf_turb_ptl_num) !20% overhead. Make as input?
- maxnum = int(100.0*diag_fullf_turb_ptl_num) !20% overhead. Make as input?
- else
- num = 0
- maxnum = 1000000
- endif
-
- spfullf(1)%num = num
- call ptl_mem_allocation( spfullf(1), 1, maxnum,ptl_mass(1), ptl_charge(1), sml_nlarmor, ptl_lost_nummax)
- !setup.F90 doesnt use the if statement, not sure why
- if (sml_electron_on) then
- spfullf(0)%num = num
- call ptl_mem_allocation( spfullf(0), 0, maxnum,ptl_mass(0), ptl_charge(0), 1 , ptl_lost_nummax)
- endif
-
- !TODO ptl_mem_allocation. Should this be general, to allow load balancing? Dont think it will be needed. Should I just use
- !ptl_mem_allocation?
- !allocate( spfullf(1)%ptl(maxnum), spfullf(1)%phase0(ptl_nphase,maxnum), &
- ! spfullf(1)%lost_index(ptl_lost_nummax) )
- !allocate( spfullf(1)%tr_save(maxnum),spfullf(1)%p_save(3,maxnum), spfullf(1)%rhoi(maxnum) )
- !TODO load. this was done in load, should it be different here?
- if (.not. allocated(sml_marker_den2)) then
- allocate(sml_marker_den2(grid%ntriangle,ptl_isp:ptl_nsp))
- endif
-
- !As a hack, set ptl_isp=1, to only load ions
- !RMC 2020/07/10 - comment out only ions, working on adding electrons
- ! sml_ptl_isp=ptl_isp
- ! ptl_isp=1
-
- print *,' Start diag_fullf_turb uniform_space ',sml_mype
- !generate spatial positions (reuse subroutine from load)
- call x_dist(grid,psn,spfullf,sml_gstep, diag_fullf_inpsi, diag_fullf_outpsi)
- if (sml_mype==0) print *,' Finished diag_fullf_turb uniform_space ',sml_mype
-
- if (sml_mype==0) print *,' Start diag_fullf_turb v_and_weight ',sml_mype
- !generate velocity, and marker weights
- call v_and_weight(grid,spfullf)
- if (sml_mype==0) print *,' Finished diag_fullf_turb v_and_weight ',sml_mype
-
- !give a gid
- do isp=ptl_isp, ptl_nsp
- ioff = sml_mype*spfullf(isp)%num
- do i=1,spfullf(isp)%num
- spfullf(isp)%ptl(i)%gid=ioff+i
- enddo
- spfullf(isp)%maxgid=sml_totalpe*spfullf(isp)%num
- enddo
-
- !As a hack, set ptl_isp=1, to only load ions, set back now
- !RMC 2020/07/10 - comment out only ions, working on adding electrons
- !ptl_isp=sml_ptl_isp
-
-#else
- print *, "ERROR!! subroutine create_fullf_makers not implemented"
-#endif
- end subroutine create_fullf_markers
-
-
-subroutine x_dist(grid,psn,spall,tindex,inpsi,outpsi)
- use grid_class
- use psn_class
- use ptl_module
- use shift_module, only : shift_check
- use sml_module
- use eq_module
- use random_xgc
- use pol_decomp_module, only : f0_inode1_save,f0_inode2_save
- implicit none
- type(grid_type), intent(in) :: grid
- type(psn_type) :: psn
- type(species_type) :: spall(0:ptl_nsp_max)
- integer, intent(in) :: tindex
- real (kind=8) :: inpsi, outpsi, rx
- integer :: isp
- integer :: valid, ierr !! number of particle that generated inside the region inpsi<psi<outpsi
- integer (8) :: total !! number of total particle generated
- real (kind=8) :: rdim, zdim !! R,Z dimension of whole simulation region
- real (kind=8) :: roffset, zoffset !! offset (start position) of simulation region
- real (kind=8) :: r,z,psi,phi
- real (kind=8) , external :: psi_interpol
- real (kind=8) :: x(2), valid2, dum, xff(2), phi_mid, total2, dum1
- integer :: itr
- real (kind=8) :: p(3), lfac, rff, zff
- real (kind=8) :: marker_den(grid%ntriangle,ptl_isp:ptl_nsp)
- integer (8) :: buf_id, buf_size, total_size
- integer :: err, isize
- character (len=256) :: filename
- integer :: ml(1), node
-
-#ifdef DIAG_FULLF
- marker_den(:,:)=0D0
-
-! simulation boundary is imposed 2001/01/24
- rdim=sml_bd_max_r - sml_bd_min_r
- roffset=sml_bd_min_r
- zdim=sml_bd_max_z - sml_bd_min_z
- zoffset=sml_bd_min_z
-
- dum=0D0
-
- do isp=ptl_isp, ptl_nsp
- valid=0
- valid2=0
- total=0
-
- ! generate particle until # of valid particles become ptl_num
- do while(valid<spall(isp)%num)
- !print *,'sml_mype,valid,valid2',sml_mype,valid,valid2
- !generate r,z in simulation region
- if (sml_cylindrical) then
- ! Cylindrical limit with periodic boundary conditions
- r=rdim*ranx() + roffset
- else
- ! Toroidal geometry
- r=sqrt(roffset**2 + rdim*ranx()*(2D0*roffset + rdim) )
- endif
-
- z=zdim*ranx() + zoffset
- psi=psi_interpol(r,z,0,0)
- total=total+1
-
- phi=(ranx()+ grid%iphi_offset)*grid%delta_phi ! set toroidal angle
- if(sml_2pi_wedge_n < phi) phi=sml_2pi_wedge_n ! just for in case
- if(phi<0D0) phi=0D0 ! just for in case
-
- !check psi validity
- if(inpsi < psi .AND. psi < outpsi) then
- ! For the correct normalization, we need to count valid2 here --->
- valid2=valid2+1D0
-
-#ifdef XGC1
- ! check inside wall validity
- x(1)=r
- x(2)=z
- phi_mid=(floor(phi/grid%delta_phi) + 0.5D0) * grid%delta_phi
-
- ! get field following posision at 1/2 angle
- call field_following_pos2(x,phi,phi_mid,xff)
- rff=xff(1)
- zff=xff(2)
-#else
- rff=r
- zff=z
-#endif
- call loading_factor(grid,rff,zff,psi,itr,p,lfac)
- !check also that particle in f0_inode range
- ml=maxloc(p)
- if (itr.gt.0) then
- node= grid%nd(ml(1),itr)
- rx=ranx()
- if ((rx .le. lfac) .and. (itr .gt. 0) .and. (node .ge. f0_inode1_save) .and. (node .le. f0_inode2_save)) then
- ! check inside wall validity
- valid=valid+1
- !set phase variables to global storage
- spall(isp)%ptl(valid)%ph(1:3)=(/ r, z, phi /)
- spall(isp)%tr_save(valid)=itr !TODO: do I need xff to find right itr? -RMC
- spall(isp)%p_save(:,valid)=p
- marker_den(itr,isp) = marker_den(itr,isp)+1D0
- endif ! (rx.le.lfac)...
- endif !(itr.gt.0)
- endif! (inpsi < psi .AND psi < outpsi)
- enddo
- enddo
-!#ifdef RESAMP_DEBUG
-! print*,maxval(marker_den)
-!#endif
-
-!print *,' Finished uniform_ marker creation sml_mype: ',sml_mype
-
- isize=grid%ntriangle*(ptl_nsp-ptl_isp+1)
- call mpi_allreduce(marker_den,sml_marker_den2,isize,MPI_REAL8,MPI_SUM,sml_comm,ierr)
- do isp=ptl_isp,ptl_nsp
- sml_marker_den2(:,isp) = sml_marker_den2(:,isp)/(real(sml_nphi_total,8)*grid%tr_vol)
- enddo
-
- !get sml_marker_den correctly
- ! This is for loading only between sml_inpsi and sml_outpsi
- call mpi_allreduce(valid2,dum,1, mpi_real8, mpi_sum, sml_comm,ierr)
- sml_marker_den=dum/real(sml_totalpe)/real(sml_monte_num)*sml_marker_den
- valid2=dum
- dum1=real(valid,8)
- call mpi_allreduce(dum1,dum,1,MPI_REAL8,MPI_SUM,sml_comm,ierr)
-
- ! check validity of toroidal angle range
- call shift_check(grid,spall(1))
- if(sml_electron_on) call shift_check(grid,spall(0))
-
-
- if (sml_mype==0) then
-
- print *,'uniform_space_dist: valid2/valid = ',valid2/dum
-
- ! Print out initial marker particle density
- isize=(ptl_nsp-ptl_isp+1)
- buf_size = 1000 + 2*4 + grid%ntriangle*8*isize
- write(filename,'("xgc.loading.",i5.5,".bp")') tindex
- ADIOS_OPEN(buf_id,'diagnosis.loading',filename,'w',sml_comm_null,err)
- ADIOS_GROUP_SIZE(buf_id,buf_size,total_size,err)
- ADIOS_WRITE_LBL(buf_id,'ntriangle',grid%ntriangle,err)
- ADIOS_WRITE_LBL(buf_id,'nsp',isize,err)
- ADIOS_WRITE_LBL(buf_id,'marker_den',sml_marker_den2,err)
- ADIOS_CLOSE(buf_id,err)
- endif
-
- return
-#else
- print *, "ERROR!! subroutine x_dist not implemented"
-#endif
-
-end subroutine x_dist
-
-
-subroutine v_and_weight(grid,spall)
- use grid_class
- use sml_module
- use ptl_module
- use eq_module
- use random_xgc
- use f0_module
- implicit none
- type(grid_type), intent(in)::grid
- type(species_type), intent(inout) :: spall(0:ptl_nsp_max)
-
- real (kind=8),external :: b_interpol, psi_interpol!, init_ipara_flow, init_epara_flow
- real (kind=8), external :: gyro_radius
- real (kind=8) :: marker_den, f, g
- integer :: i,sp_type, isp
- real (kind=8) :: r,z,x(2),phi,psi,t_ev,up,b,bvec(3),mu_n,vp_n,rho,mu
- logical :: err
-
-#ifdef DIAG_FULLF
- err = .false.
-
-
- ! obtain rho and mu
- do isp=ptl_isp, ptl_nsp
- if(isp==1) then ! main ion
- marker_den=sml_marker_den
- elseif(isp==0) then ! electron
- marker_den=sml_marker_den*real(spall(0)%num)/real(spall(1)%num)
- endif
-
- do i=1, spall(isp)%num
- !retrive position variable from the uniform_space_dist
-
- x=spall(isp)%ptl(i)%ph(1:2)
- r=x(1)
- z=x(2)
- phi=spall(isp)%ptl(i)%ph(3)
- psi=psi_interpol(r,z,0,0)
-
- !get magnetic field
- call bvec_interpol(r,z,phi,bvec(1),bvec(2),bvec(3))
-
- !get temperature and flow
- if(isp==1) then
- t_ev=eq_ftn(psi,r,z,eq_tempi)
- else
- t_ev=eq_ftn(psi,r,z,eq_tempe)
- endif
- ! Parallel velocity offset - initial flow
- if(sml_initial_flow) then
- if(isp==1) then ! ion
- up=eq_ftn(psi,r,z,eq_flowi) !init_ipara_flow(psi,z)
- else
- up=eq_ftn(psi,r,z,eq_flowe) !init_epara_flow(psi,z)
- endif
- !rh I assume that the input rotation profile is the toroidal angular
- !rh velocity --> multiply up by r to get actual velocity
- !rh and project to the parallel direction
- up = up*r*bvec(3)/b
- else
- up=0D0
- endif
- b=sqrt(bvec(1)**2+bvec(2)**2+bvec(3)**2)
-
- !generate the rho, mu, and weight adjustment (marker distribution piece)
- call load_flat_v_single_general(t_ev, up, b, ptl_mass(isp), ptl_charge(isp), rho, mu, g)
- spall(isp)%ptl(i)%ph(pirho)=rho
- spall(isp)%ptl(i)%ct(pim)=mu
- !print *, sml_mype, 'x,mu', x,mu
- !print *, sml_mype, 'isp,i,gyro_radius', isp,i,gyro_radius(x,mu)
- !print *, sml_mype, 'shape(spall(isp)%rhoi)', shape(spall(isp)%rhoi)
- !print *, sml_mype, 'allocated(spall(isp)%rhoi)', allocated(spall(isp)%rhoi)
- spall(isp)%rhoi(i)=gyro_radius(x,mu) !gyro-radius
-
- !now, get the interpolated f at the specified phase space position (x,rho,mu)
- !similar to f0_get_f0g
-#ifndef V_PERP
- mu_n=spall(isp)%ptl(i)%ct(pim)*(2.*eq_axis_b)/(t_ev*sml_ev2j) ! mu_n here is mu2B_n in f0_get_f0g
-#else
- ! mu_n becomes (v_perp/v_th)^2 here --->
- mu_n=spall(isp)%ptl(i)%ct(pim)*(2.*b/(t_ev*sml_ev2j))
-#endif
- vp_n=ptl_c_m(isp)*spall(isp)%ptl(i)%ph(pirho)*b/sqrt(t_ev*sml_ev2j/ptl_mass(isp))
- call f0_get_fgrid(grid,f0_f_save,f0_B_B0_save,f0_T_ev_save,f0_inode1_save,f0_inode2_save,isp,spall(isp)%tr_save(i),spall(isp)%p_save(:,i),phi,mu_n,vp_n,f,err)
-
- g = sml_marker_den2(spall(isp)%tr_save(i),isp)*g
- spall(isp)%ptl(i)%ct(piw0) = f/g
- enddo !i
- enddo !isp
-
-#else
- print *, "ERROR! subroutine v_and_weight not implemented"
-#endif
-
- end subroutine v_and_weight
-
-
- !TODO: Should I just rearrange load_flat_v_single in load.F90 so not duplicating here?
- !Only thing stopping is load_flat_v_single has Maxwellian w0 assumption (prob should make general)
- subroutine load_flat_v_single_general(t_ev, up, b, mass, charge, rho, mu, gout)
- use sml_module
- use random_xgc
- implicit none
- real (8) , intent(in) :: t_ev, up, b, mass, charge
- real (8) , intent(out) :: rho, mu, gout
- !
- real (8) :: temp, vth, maxwell_norm, vshift
- real (8) :: va, w, vc, v, g
- ! C :: normalized constant
- ! va : start of exp decay
- ! w : width of exp decay
- ! vc : cut-off v - no particle after v_c
-
-#ifdef DIAG_FULLF
-
- temp=t_ev*sml_ev2j
- vth=sqrt(temp/mass)
-
- ! parallel velocity distribution
- va=sml_flat_marker_decay_start1 *vth
- vc=sml_flat_marker_cutoff1 *vth
- w =sml_flat_marker_width1 *vth
-
- call get_v_and_dist
-
- v=v*sign(1D0, ranx()-0.5D0) ! relative parallel velocity
- vshift= v + up ! absolute parallel velocity (shift of velocity)
- rho=vshift/b*mass/charge !*mass/charge
-
-
- gout = g*0.5D0 ! actual g is half due to -v and v direction
-
-
- ! perp velocity distribution
-
- va=sml_flat_marker_decay_start2 *vth
- vc=sml_flat_marker_cutoff2 *vth
- w =sml_flat_marker_width2 *vth
-
- call get_v_and_dist
-
- mu=0.5D0*mass*v*v/b
-
- gout = gout*g
-#else
- print *, "ERROR!! subroutine load_flat_v_single_general not implemented."
-#endif
-
- contains
- subroutine get_v_and_dist ! input:: v_a, v_c, w , output:: v, g
- implicit none
- real (8) :: c ! c is constant for each direction - can be stored as global variable
- real (8) :: A
-
- c=1D0/(va + w*(1D0 - dexp(-(vc-va)/w)))
-
- A=ranx()
- if(A < c*va) then
- v=A/c
- g=c
- else
- v=va - w*dlog(1D0 + (va-A/c)/w)
- g=c*dexp(-(v-va)/w)
- endif
-
- end subroutine get_v_and_dist
- end subroutine load_flat_v_single_general
-
-
-
-!save the current species psi for later use
-subroutine diag_fullf_save_psi(sp)
- use sml_module
- use diag_module
- use ptl_module
- use omp_module , only : split_indices
- implicit none
- type(species_type) :: sp
- real (kind=8), external :: psi_interpol, b_interpol
- integer :: i, ith, i_beg(sml_nthreads), i_end(sml_nthreads)
-
-#ifdef DIAG_FULLF
-
- if (allocated(diag_fullf_psi_save)) deallocate(diag_fullf_psi_save)
- if (allocated(diag_fullf_gid_save)) deallocate(diag_fullf_gid_save)
- allocate(diag_fullf_psi_save(sp%maxnum))
- allocate(diag_fullf_gid_save(sp%maxnum))
- call split_indices(sp%num, sml_nthreads, i_beg, i_end)
-
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I)
- do ith=1, sml_nthreads
- do i=i_beg(ith), i_end(ith)
- diag_fullf_psi_save(i)=psi_interpol(sp%ptl(i)%ph(pir),sp%ptl(i)%ph(piz),0,0)
- diag_fullf_gid_save(i)=sp%ptl(i)%gid
- enddo
- enddo
-
-#else
- print *, "Error!! subroutine diag_fullf_save_psi not implemented"
-#endif
-end subroutine diag_fullf_save_psi
-
-
-!resets the dr and tr_init to restart particle tracing
-subroutine diag_fullf_reset(sp)
- use sml_module
- use ptl_module
- use omp_module , only : split_indices
- implicit none
- type(species_type) :: sp
- integer :: i, ith, i_beg(sml_nthreads), i_end(sml_nthreads)
-
-#ifdef DIAG_FULLF
-
- call split_indices(sp%num, sml_nthreads, i_beg, i_end)
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I)
- do ith=1, sml_nthreads
- do i=i_beg(ith), i_end(ith)
- sp%ptl(i)%ph(pidr) = 0D0
- sp%ptl(i)%ph(pitrinit) = sp%tr_save(i)
- enddo
- enddo
-
-#else
- print *, "ERROR!! subroutine diag_fullf_reset only implemented for -DDIAG_FULLF"
-#endif
-end subroutine diag_fullf_reset
-
-!interpolate psi and RBpol at particle position
-subroutine diag_fullf_calc_psi_RBpol(sp,psi,RBpol)
- use sml_module
- use ptl_module
- use omp_module , only : split_indices
- implicit none
- type(species_type) :: sp
- real (kind=8), external :: psi_interpol
- integer :: i, ith, i_beg(sml_nthreads), i_end(sml_nthreads)
- real (kind=8) :: psi(sp%num), RBpol(sp%num), br, bz, bphi
-
-#ifdef DIAG_FULLF
-
- call split_indices(sp%num, sml_nthreads, i_beg, i_end)
-
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I)
- do ith=1, sml_nthreads
- do i=i_beg(ith), i_end(ith)
- psi(i)=psi_interpol(sp%ptl(i)%ph(pir),sp%ptl(i)%ph(piz),0,0)
- call bvec_interpol(sp%ptl(i)%ph(pir),sp%ptl(i)%ph(piz),0D0,br,bz,bphi)
- RBpol(i) = sp%ptl(i)%ph(pir) * sqrt(br**2D0 + bz**2D0)
- enddo
- enddo
-
-#else
- print *, "ERROR!! subroutine diag_fullf_calc_psi_RBpol only implemented for -DDIAG_FULLF"
-#endif
-end subroutine diag_fullf_calc_psi_RBpol
-
-
-!calculate and accumulate dr, calculated dr = dpsi/RBpol, where RBpol is the linear average between the two points
-subroutine diag_fullf_calc_dr(sp,psi_start,RBpol_start,psi_stop,RBpol_stop)
- use sml_module
- use ptl_module
- use omp_module , only : split_indices
- implicit none
- type(species_type) :: sp
- integer :: i, ith, i_beg(sml_nthreads), i_end(sml_nthreads)
- real (kind=8) :: psi_start(sp%num), psi_stop(sp%num), RBpol_start(sp%num), RBpol_stop(sp%num)
-
-#ifdef DIAG_FULLF
-
- call split_indices(sp%num, sml_nthreads, i_beg, i_end)
-
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I)
- do ith=1, sml_nthreads
- do i=i_beg(ith), i_end(ith)
- sp%ptl(i)%ph(pidr) = sp%ptl(i)%ph(pidr) + 0.5D0*(1D0/RBpol_stop(i) + 1D0/RBpol_start(i))*(psi_stop(i) - psi_start(i))
- enddo
- enddo
-
-#else
- print *, "Error!! subroutine diag_fullf_calc_dr only implemented for -DDIAG_FULLF"
-#endif
-
-end subroutine diag_fullf_calc_dr
-
-
-subroutine diag_fullf_tracer(grid,spstop,icycle,ncycle)
- use sml_module
- use grid_class
- use omp_module , only : split_indices
- use diag_module
- use ptl_module
- use mpi
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(species_type) :: spstop
- real (kind=8), external :: psi_interpol
- integer :: i, ith, i_beg(sml_nthreads), i_end(sml_nthreads)
- real (kind=8) :: En, w0, w1, N, dt, psi
- real(kind=8) :: dr_average(grid%ntriangle), En_dr_average(grid%ntriangle), dr_std(grid%ntriangle), En_dr_std(grid%ntriangle)
- integer :: marker_den(grid%ntriangle)
- integer :: icycle, ncycle, ind, itr
- character (len=256) :: filename, file_suffix
- integer*8 :: buf_id, buf_size, total_size
- integer :: err
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- logical, save :: isfirst = .true.
-
-#ifdef DIAG_FULLF
-
- !currently, I calculate the change in sqrt(psi) for each individual particle,
- !then for each triangle, ensemble average this weighted by the energy
- !sqrt(psi) is used as a pseudo-distance (shouldq normalize out the magnetic field also)
- ! < |dr - <dr>|**2 >
- call split_indices(spstop%num, sml_nthreads, i_beg, i_end)
-
-
-
- marker_den(:) = 0D0
- dr_average(:) = 0D0
- En_dr_average(:) = 0D0
-
- !!!!!!FIRST loop calculates <E*w0*w1*dr> in final triangle. E, w0, w1, psi are taken from initial position though
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I)
- do ith=1, sml_nthreads
- !ctr = 0
- do i=i_beg(ith), i_end(ith)
- !only get particles that arent removed, or didnt hit the wall
- if(spstop%ptl(i)%gid>0) then
- itr = int(spstop%ptl(i)%ph(pitrinit))
- print *, sml_mype, ' diag_fullf_tracer itr=', itr
- marker_den(itr) = marker_den(itr) + 1
- !if(sml_mype .eq. 0) then
- ! print *, " itr=", itr, "/", grid%ntriangle, ", dr_average=", dr_average(itr), marker_den(itr) !w0, w1, spstop%ptl(i)%ph(pidr)
- !endif
- !get data from ending position
- call get_E_w0w1(spstop%ptl(i),En, w0, w1)
- !TODO: Look into if I need to use w1, currently don't set in the create_fullf_markers. This means w0 only used,
- !and its fixed
- !TODO: do I need a volume here
- dr_average(itr) = dr_average(itr) + w0*(1D0+w1)*spstop%ptl(i)%ph(pidr)
- En_dr_average(itr) = En_dr_average(itr) + En*w0*(1D0+w1)*spstop%ptl(i)%ph(pidr)
- endif
- enddo
- !if (sml_mype .eq. 0) then
- ! print *, "ith = ", ith, ", i_beg = ", i_beg(ith), ", i_end = ", i_end(ith), ", processed ", ctr ," particles."
- !endif
- enddo
-
- !if (sml_mype .eq. 0) then
- ! print *, 'In routine diag_fullf_tracer. dr_average(1) = ', dr_average(1)
- !endif
-
- !mpi calls to sum from all processes
- !TODO Does this just need to be sml_comm?
- !TODO Can we make this more efficient? Most are 0's, don't need to be communicated
- call mpi_allreduce(MPI_IN_PLACE,marker_den,grid%ntriangle,MPI_INTEGER,MPI_SUM,sml_comm,err)
- call mpi_allreduce(MPI_IN_PLACE,dr_average,grid%ntriangle,MPI_REAL8,MPI_SUM,sml_comm,err)
- call mpi_allreduce(MPI_IN_PLACE,En_dr_average,grid%ntriangle,MPI_REAL8,MPI_SUM,sml_comm,err)
-
- !create true average after the MPI allreduce
- do i=1,grid%ntriangle
- if (marker_den(i)>0) then
- dr_average(i) = dr_average(i)/marker_den(i)
- En_dr_average(i) = En_dr_average(i)/marker_den(i)
- endif
- enddo
-
- !!!!!!Now, calculate < |dr - <dr>|**2 >
- dr_std(:) = 0D0
- En_dr_std(:) = 0D0
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I)
- do ith=1, sml_nthreads
- do i=i_beg(ith), i_end(ith)
- N = marker_den(int(spstop%ptl(i)%ph(pitrinit)))
- if((spstop%ptl(i)%gid>0) .and. (N>0)) then
- itr = int(spstop%ptl(i)%ph(pitrinit))
- call get_E_w0w1(spstop%ptl(i),En,w0,w1)
- !if isnan(En_dr_std(spstop%ptl(i)%ph(pitrinit))) print *, sml_mype, 'En_dr_std is nan', i, spstop%ptl(i)%ph(pitrinit)
- dr_std(itr) = dr_std(itr) + ((w0*(1D0+w1)*spstop%ptl(i)%ph(pidr) - dr_average(itr))**2D0)/N
- En_dr_std(itr) = En_dr_std(itr) + ((En*w0*(1D0+w1)*spstop%ptl(i)%ph(pidr) - En_dr_average(itr))**2D0)/N
- endif
- enddo
- enddo
-
- !mpi calls to sum from all processes
- !TODO Does this just need to be sml_comm?
- !TODO Can we make this more efficient? Most are 0's, don't need to be communicated
- call mpi_allreduce(MPI_IN_PLACE,dr_std,grid%ntriangle,MPI_REAL8,MPI_SUM,sml_comm,err)
- call mpi_allreduce(MPI_IN_PLACE,En_dr_std,grid%ntriangle,MPI_REAL8,MPI_SUM,sml_comm,err)
-
- !ADIOS calls
- !TODO: jyc?
- !save:
- ! En_dsqrtpsi_average(grid%ntriangle)
- ! En_dsqrtpsi_std(grid%ntriangle)
- ! marker_den(grid%ntriangle)
- !TODO: When add new capability to cross over gstep, need to update with global way to get dt
- dt = icycle/ncycle*sml_dt
- ind = icycle
- write (file_suffix, "(A6,I0.3)") "diag1_",mod(sml_gstep,diag_fullf_turb_period)-1
- write(filename,'("xgc.diag_fullf.",i5.5,".",a,".",i5.5,".bp")') sml_gstep, trim(file_suffix), ind
-
- ! (2020/08) jyc: values are same for all processes. let only rank=0 write.
- if (sml_mype.eq.0) then
- if(isfirst) then
- isfirst=.false.
- ADIOS2_DECLARE(io,'fullf.tracer',err)
- ADIOS2_DEFINE_LBL(var,io,'timestep',sml_gstep,err)
- ADIOS2_DEFINE_LBL(var,io,'dt',dt,err)
- ADIOS2_DEFINE_LBL(var,io,'ntriangle',grid%ntriangle,err)
- ADIOS2_DEFINE_LBL(var,io,'dr_average',dr_average,err)
- ADIOS2_DEFINE_LBL(var,io,'dr_std',dr_std,err)
- ADIOS2_DEFINE_LBL(var,io,'En_dr_average',En_dr_average,err)
- ADIOS2_DEFINE_LBL(var,io,'En_dr_std',En_dr_std,err)
- ADIOS2_DEFINE_LBL(var,io,'marker_den',marker_den,err)
- endif
-
- ADIOS2_OPEN(engine,io,trim(filename),adios2_mode_write,sml_comm_self,err)
- ADIOS2_WRITE_LBL(engine,'timestep',sml_gstep,err)
- ADIOS2_WRITE_LBL(engine,'dt',dt,err)
- ADIOS2_WRITE_LBL(engine,'ntriangle',grid%ntriangle,err)
- ADIOS2_WRITE_LBL(engine,'dr_average',dr_average,err)
- ADIOS2_WRITE_LBL(engine,'dr_std',dr_std,err)
- ADIOS2_WRITE_LBL(engine,'En_dr_average',En_dr_average,err)
- ADIOS2_WRITE_LBL(engine,'En_dr_std',En_dr_std,err)
- ADIOS2_WRITE_LBL(engine,'marker_den',marker_den,err)
- ADIOS2_CLOSE(engine,err)
- endif
-#else
- print *, "ERROR!! subroutine diag_fullf_tracer only implemented for -DDIAG_FULLF"
-#endif
-
-#ifdef ADIOS1
- buf_size = 20 + 4 + 8 + 4 ! 20 for safety
- buf_size = buf_size + 8*3*grid%ntriangle
-
-
- ADIOS_OPEN(buf_id,'fullf.tracer',filename,'w',sml_comm,err)
- ADIOS_GROUP_SIZE(buf_id,buf_size,total_size,err)
- ADIOS_WRITE_LBL(buf_id,'timestep',sml_gstep,err)
- ADIOS_WRITE_LBL(buf_id,'dt',dt,err)
- ADIOS_WRITE_LBL(buf_id,'ntriangle',grid%ntriangle,err)
-
- !TODO: better way to write this? with the mpi_allreduce, should be the same on all processes
- ADIOS_WRITE_LBL(buf_id,'dr_average',grid%ntriangle,err)
- ADIOS_WRITE_LBL(buf_id,'dr_std',grid%ntriangle,err)
- ADIOS_WRITE_LBL(buf_id,'En_dr_average',grid%ntriangle,err)
- ADIOS_WRITE_LBL(buf_id,'En_dr_std',grid%ntriangle,err)
- ADIOS_WRITE_LBL(buf_id,'marker_den',grid%ntriangle,err)
- ADIOS_CLOSE(buf_id,err)
-#endif
-
-
-
-contains
- subroutine get_E_w0w1(ptli,E,w0,w1)
- use ptl_module
- implicit none
- type(ptl_type) :: ptli
- real (kind=8), external :: psi_interpol, b_interpol
- real (kind=8) :: r,z,phi,w0,w1,B,rho,mu,E,psi
-
- r=ptli%ph(pir)
- z=ptli%ph(piz)
- phi=ptli%ph(pip)
- w0=ptli%ct(piw0)
- w1=ptli%ph(piw1)
-
- !calculate particle energy
- !TODO determine if want to do similar to diag_1d_port1, so don't have to recalculate these B,psi
- B=b_interpol(r,z,phi)
- rho=ptli%ph(pirho)
- mu=ptli%ct(pim)
- E = ptl_c2_2m(0)*(rho*B)**2 + mu*B
-
- end subroutine get_E_w0w1
-
-end subroutine diag_fullf_tracer
diff --git a/XGC1/diagnosis.F90 b/XGC1/diagnosis.F90
index 0bb28018..f1ea9d88 100644
--- a/XGC1/diagnosis.F90
+++ b/XGC1/diagnosis.F90
@@ -64,7 +64,7 @@ subroutine diagnosis(istep,irk,grid,psn,spall)
if(diag_particle_mod/=0) then
if(mod(istep,diag_particle_period)==0) then
call t_startf("DIAG_PARTICLE")
- call diag_particle(grid,psn,spall,sml_gstep)
+ call diag_particle(grid,psn,spall)
call t_stopf("DIAG_PARTICLE")
endif
endif
@@ -235,7 +235,7 @@ subroutine diag_1d_output(grid,psn)
type(adios2_engine), save :: engine
type(adios2_io), save :: io
type(adios2_variable) :: varid
- logical, save :: isfirst = .true.
+ logical, save :: init=.false.
integer(8), dimension(1) :: oneDsize, oneDstart, oneGsize, oneGstart
#endif
@@ -428,8 +428,7 @@ subroutine diag_1d_output(grid,psn)
#ifdef ADIOS2
!@effis-begin 'diagnosis.1d'->'diagnosis.1d'
- if (isfirst) then
- isfirst = .false.
+ if (.not.init) then
oneDsize(1) = np
oneDstart(1) = 0
oneGsize(1) = grid%npsi00
@@ -503,6 +502,7 @@ subroutine diag_1d_output(grid,psn)
else
call adios2_open(engine, io, 'xgc.oneddiag.bp', adios2_mode_append, sml_comm_self, err)
endif
+ init = .true.
endif
call adios2_begin_step(engine, adios2_step_mode_append, err)
@@ -1229,7 +1229,6 @@ contains
type(adios2_engine), save :: engine
type(adios2_io), save :: io
type(adios2_variable) :: var
- logical, save :: isfirst = .true.
integer :: istatus
character (len=256) :: filename
@@ -1239,8 +1238,7 @@ contains
!@effis-begin "field3D"->"field3D"
!! ADIOS2 define variables
- if(isfirst) then
- isfirst=.false.
+ if(sml_istep/diag_3d_period==1) then
write(filename2,'("xgc.3d.bp")')
call adios2_declare_io(io, adios2obj, "field3D", err)
call adios2_comm_define_variable(var, io, 'nnode', nnode, err)
@@ -1764,7 +1762,6 @@ subroutine diag_rmp(istep,grid,psn)
#ifdef ADIOS2
nrho=grid%nrho+1
if (isfirst) then
- isfirst=.false.
ADIOS2_DECLARE(io,'rmp', err)
ADIOS2_DEFINE_LBL(var,io,'nnode',nnode,err)
ADIOS2_DEFINE_LBL(var,io,'nsurf',grid%npsi_surf2,err)
@@ -1782,6 +1779,7 @@ subroutine diag_rmp(istep,grid,psn)
ADIOS2_DEFINE_LBL(var,io,'dA_phi',ptb_3db_dA_phi,err)
ADIOS2_DEFINE_LBL(var,io,'dA_phi_mn_re',dA_phi_mn_re,err)
ADIOS2_DEFINE_LBL(var,io,'dA_phi_mn_im',dA_phi_mn_im,err)
+ isfirst=.false.
endif
ADIOS2_OPEN(engine,io,filename,adios2_mode_write,sml_comm_self,err)
@@ -1851,7 +1849,6 @@ subroutine diag_f0(istep,grid,psn,flag)
#ifdef ADIOS2
use adios2_comm_module
#endif
- use dcx_coupling_module
implicit none
integer, intent(in) :: istep
type(grid_type) :: grid
@@ -1889,7 +1886,6 @@ subroutine diag_f0(istep,grid,psn,flag)
type(adios2_io), save :: io
type(adios2_variable) :: var
type(adios2_attribute) :: att
- logical, save :: isfirst = .true.
#endif
#ifdef DIAG_NOISE
interface
@@ -1951,8 +1947,7 @@ subroutine diag_f0(istep,grid,psn,flag)
iden_f0_approx=tmp ! mpi reduce
#ifdef ADIOS2
- if (isfirst) then
- isfirst=.false.
+ if (istep/diag_f0_period.eq.1) then
! Definition of variables
if (sml_mype == 0) print *, 'ADIOS2: Define variables for f0'
call adios2_declare_io(io, adios2obj, 'f0', err)
@@ -2333,53 +2328,6 @@ subroutine diag_f0(istep,grid,psn,flag)
call diag_f0_noise(istep,grid,psn,flag)
#endif
-#ifdef XGC1
- !! DCX coupling
- if (dcx_side.eq.0) then
- if ((mod(sml_gstep+dcx_step_offset,dcx_write_f0_period).eq.0)) then
- if (sml_mype.eq.0) print *, sml_mype, 'DCX coupling wait f0', dcx_side, sml_gstep
- call t_startf("DCX_COUPLING_WAIT")
- call mpi_barrier(MPI_COMM_WORLD, err);
- call t_stopf("DCX_COUPLING_WAIT")
- call t_startf("DCX_WRITE_F0")
- call dcx_write_f0(grid,psn)
- call t_stopf("DCX_WRITE_F0")
- endif
- else
- if ((mod(sml_gstep+dcx_step_offset,dcx_read_f0_period).eq.0)) then
- if (sml_mype.eq.0) print *, sml_mype, 'DCX coupling wait f0', dcx_side, sml_gstep
- call t_startf("DCX_COUPLING_WAIT")
- call mpi_barrier(MPI_COMM_WORLD, err);
- call t_stopf("DCX_COUPLING_WAIT")
- call t_startf("DCX_READ_F0")
- call dcx_read_f0(grid,psn)
- call t_stopf("DCX_READ_F0")
- endif
- endif
-
- !! DCX coupling
- if (dcx_side.eq.0) then
- if ((mod(sml_gstep+dcx_step_offset,dcx_write_ff_period).eq.0)) then
- if (sml_mype.eq.0) print *, sml_mype, 'DCX coupling wait ff', dcx_side, sml_gstep
- call t_startf("DCX_COUPLING_WAIT")
- call mpi_barrier(MPI_COMM_WORLD, err);
- call t_stopf("DCX_COUPLING_WAIT")
- call t_startf("DCX_WRITE_FF")
- call dcx_write_ff(grid,psn)
- call t_stopf("DCX_WRITE_FF")
- endif
- else
- if ((mod(sml_gstep+dcx_step_offset,dcx_read_ff_period).eq.0)) then
- if (sml_mype.eq.0) print *, sml_mype, 'DCX coupling wait ff', dcx_side, sml_gstep
- call t_startf("DCX_COUPLING_WAIT")
- call mpi_barrier(MPI_COMM_WORLD, err);
- call t_stopf("DCX_COUPLING_WAIT")
- call t_startf("DCX_READ_FF")
- call dcx_read_ff(grid,psn)
- call t_stopf("DCX_READ_FF")
- endif
- endif
-#endif
end subroutine diag_f0
#ifdef DIAG_NOISE
@@ -3625,7 +3573,6 @@ subroutine tracer(n,sp_type,grid,psn,spall)
type(adios2_engine), save :: engine
type(adios2_io), save :: io
type(adios2_variable) :: var
- logical, save :: isfirst = .true.
#endif
@@ -3695,8 +3642,7 @@ subroutine tracer(n,sp_type,grid,psn,spall)
buf_size = 4 + ncol_tracer * 8
! print *, 'adios writing fort.tracer group, #bytes = ', buf_size
#ifdef ADIOS2
- if(isfirst) then
- isfirst=.false.
+ if(sml_gstep/diag_tracer_period.eq.1) then
ADIOS2_DECLARE(io,'fort.tracer',err)
ADIOS2_DEFINE_LBL(var,io,'/tracer/ncol_tracer',ncol_tracer,err)
ADIOS2_DEFINE_LBL(var,io,'/tracer/tracerdata',tracerdata,err)
@@ -4582,7 +4528,6 @@ subroutine diag_neu_output(new_n0)
type(adios2_engine), save :: engine
type(adios2_io), save :: io
type(adios2_variable) :: var
- logical, save :: isfirst = .true.
#endif
var_names(1) = 'dn'
@@ -4612,8 +4557,7 @@ subroutine diag_neu_output(new_n0)
pnorm=pall/eq_x_psi
#ifdef ADIOS2
- if(isfirst) then
- isfirst=.false.
+ if(sml_gstep/neu_col_period.eq.1) then
ADIOS2_DECLARE(io,'diagnosis.neu',err)
ADIOS2_DEFINE_LBL(var,io,'samples',diag_neu_npsi,err)
ADIOS2_DEFINE_LBL(var,io,'time',sml_time,err)
@@ -4916,7 +4860,6 @@ subroutine diag_heat_output
type(adios2_engine), save :: engine
type(adios2_io), save :: io
type(adios2_variable) :: var
- logical, save :: isfirst = .true.
#endif
var_names(1) ='number'
@@ -4968,8 +4911,7 @@ subroutine diag_heat_output
enddo
#ifdef ADIOS2
- if(isfirst) then
- isfirst=.false.
+ if(sml_gstep/diag_1d_period==1) then
ADIOS2_DECLARE(io,'diagnosis.heat',err)
ADIOS2_DEFINE_LBL(var,io,'rsamples',diag_heat_nr,err)
ADIOS2_DEFINE_LBL(var,io,'zsamples',diag_heat_nz,err)
@@ -5064,8 +5006,7 @@ subroutine diag_heat_output
else
if(sml_mype==0) then
#ifdef ADIOS2
- if(isfirst) then
- isfirst=.false.
+ if(sml_gstep/diag_1d_period==1) then
ADIOS2_DECLARE(io,'diagnosis.heat2',err)
ADIOS2_DEFINE_LBL(var,io,'nseg',diag_heat_nseg,err)
ADIOS2_DEFINE_LBL(var,io,'nseg1',diag_heat_nseg+1,err)
@@ -5192,14 +5133,12 @@ subroutine diag_sheath(grid)
type(adios2_engine), save :: engine
type(adios2_io), save :: io
type(adios2_variable) :: var
- logical, save :: isfirst = .true.
#endif
if(sml_mype==0 ) then
#ifdef ADIOS2
- if(isfirst) then
- isfirst=.false.
+ if(sml_gstep/diag_1d_period==1) then
ADIOS2_DECLARE(io,'diagnosis.sheath',err)
ADIOS2_DEFINE_LBL(var,io,'nwall',grid%nwall,err)
ADIOS2_DEFINE_LBL(var,io,'sheath_nphi',sheath_nphi,err)
@@ -5519,7 +5458,6 @@ subroutine diag_f0_df(istep,grid)
write(filename,'("xgc.fsourcediag",".",i5.5,".bp")') sml_gstep
#ifdef ADIOS2
if (isfirst) then
- isfirst=.false.
ADIOS2_DECLARE(io,'diagnosis.fsource',err)
ADIOS2_DEFINE_LBL(var,io,'samples',np,err)
ADIOS2_DEFINE_LBL(var,io,'time',sml_time,err)
@@ -5546,6 +5484,7 @@ subroutine diag_f0_df(istep,grid)
ADIOS2_DEFINE_LBL(var,io,sp_name(isp)//trim(var_names(ivar))//trim(source_names(isource)),tmp,err)
enddo
enddo
+ isfirst=.false.
endif
ADIOS2_OPEN(engine,io,filename,adios2_mode_write,sml_comm_self,err)
@@ -5642,8 +5581,7 @@ subroutine diag_f0_df(istep,grid)
end subroutine
-
-subroutine diag_particle(grid, psn, spall, step)
+subroutine diag_particle(grid, psn, spall)
use sml_module
use grid_class
use psn_class
@@ -5664,7 +5602,6 @@ subroutine diag_particle(grid, psn, spall, step)
integer, parameter :: ict2=ptl_nphase+ptl_nconst
integer :: isp
- integer :: step
character (len=256) :: filename
integer*8 :: buf_id, buf_size, total_size
@@ -5706,7 +5643,7 @@ subroutine diag_particle(grid, psn, spall, step)
if (adios_stage_particle) then
write(filename,'("xgc.particle.bp")')
else
- write(filename,'("xgc.particle.",i5.5,".bp")') step
+ write(filename,'("xgc.particle.",i5.5,".bp")') sml_gstep
endif
#ifdef ADIOS2
@@ -5767,12 +5704,12 @@ contains
type(adios2_variable), save :: vtimestep, vtime
type(adios2_variable), save :: vigid, viphase
type(adios2_variable), save :: vegid, vephase
- logical, save :: isfirst = .true.
real :: timeout = 0.0
integer :: istatus
- if(isfirst) then
- isfirst=.false.
+ if(sml_istep/diag_particle_period==1) then
+ ! Note: have to check sml_istep not sml_gstep. istep starts from 0 at each run,
+ ! gstep keeps increasing over restarts
! Definition of variables
call adios2_declare_io(io, adios2obj, "particles", err)
call adios2_define_variable(vtimestep, io, "timestep", adios2_type_integer4, err)
@@ -5854,11 +5791,11 @@ contains
do i=1, spall(isp)%num
gid1=spall(isp)%ptl(i)%gid
- !if(gid1>0) then
+ if(gid1>0) then
if(mod(gid1-1,diag_particle_mod)==0) then
num=num+1
endif
- !endif
+ endif
enddo
end subroutine
@@ -5892,286 +5829,21 @@ contains
do i=1, spall(isp)%num
gid1=spall(isp)%ptl(i)%gid
- !if(gid1>0) then
+ if(gid1>0) then
if(mod(gid1-1,diag_particle_mod)==0) then
n=n+1
phase(1:ptl_nphase,n)=spall(isp)%ptl(i)%ph
phase(ict1:ict2,n) =spall(isp)%ptl(i)%ct
gid(n)=gid1
endif
- !endif
+ endif
enddo
end subroutine
end subroutine
-subroutine diag_particle2(grid, psn, spall, step, suffix)
- use sml_module
- use grid_class
- use psn_class
- use ptl_module
- use diag_module
- type(grid_type) :: grid
- type(psn_type) :: psn
- type(species_type) :: spall(0:ptl_nsp_max)
- character (len=*), intent(in) :: suffix
- !
- integer :: inum ! ion particle number to be saved per proc
- integer*8 :: ioffset, itotal
- integer :: enum ! electron particle number to be saved per proc
- integer*8 :: eoffset, etotal
- !
- real (4), allocatable :: iphase(:,:), ephase(:,:) ! 32-bit real
- integer (8), allocatable :: igid(:), egid(:)
- integer, parameter :: ict1=ptl_nphase+1
- integer, parameter :: ict2=ptl_nphase+ptl_nconst
-
- integer :: isp
- integer :: step
-
- character (len=256) :: filename
- integer*8 :: buf_id, buf_size, total_size
- integer :: err
-
- ! count numbers of particles to be saved for each processor and allocate memory------
-
- !ion
- isp=1
- call count_num(isp,inum)
- allocate(iphase(ict2,inum),igid(inum))
-
-
- !electron
- if(sml_electron_on) then
- isp=0
- call count_num(isp,enum)
- allocate(ephase(ict2,enum),egid(enum))
- endif
-
-
- ! get off set numbers in global array --------------------------------
- call get_offset(inum,ioffset,itotal)
- if(sml_electron_on) call get_offset(enum, eoffset,etotal)
-
-
- ! prepare ion data to be saved and write------------------------------
-
- !ion
- isp=1
- call prep_data(isp,inum,iphase,igid)
-
- !electron
- if(sml_electron_on) then
- isp=0
- call prep_data(isp,enum,ephase,egid)
- endif
-
- if (adios_stage_particle) then
- write(filename,'("xgc.particle.",a,".bp")') trim(suffix)
- else
- write(filename,'("xgc.particle.",a,".",i5.5,".bp")') trim(suffix), step
- endif
- !print *, sml_mype, 'diag_particle2 filename: ', trim(filename)
-
-#ifdef ADIOS2
- call write_particles_adios2()
-#else
- call write_particles_adios()
-#endif
-
-!deallocate -----------------------------------------------------
-deallocate(iphase,igid)
-if(sml_electron_on) deallocate(ephase,egid)
-
-
-contains
-
- subroutine write_particles_adios()
- implicit none
- integer*8 :: buf_id, buf_size, total_size
-
- ! Write to file -----------------------------------------------
- buf_size = 20 + 4 + 8 ! 20 for safety
- buf_size = buf_size + 8 + 8 + 8 + 4 + ict2*inum*4 + inum*8
- if(sml_electron_on) then
- buf_size = buf_size + 8 + 8 + 8 + 4 + ict2*enum*4 + enum*8
- endif
-
- ADIOS_OPEN(buf_id,'particle',filename,'w',sml_comm,err)
- ADIOS_GROUP_SIZE(buf_id,buf_size,total_size,err)
- ADIOS_WRITE_LBL(buf_id,'timestep',sml_gstep,err)
- ADIOS_WRITE_LBL(buf_id,'time',sml_time,err)
-
- ADIOS_WRITE_LBL(buf_id,'inum_total',itotal,err)
- ADIOS_WRITE_LBL(buf_id,'inum',inum,err)
- ADIOS_WRITE_LBL(buf_id,'ioff',ioffset,err)
- ADIOS_WRITE_LBL(buf_id,'inphase',ict2,err)
- ADIOS_WRITE_LBL(buf_id,'igid',igid,err)
- ADIOS_WRITE_LBL(buf_id,'iphase',iphase,err)
-
- if(sml_electron_on) then
- ADIOS_WRITE_LBL(buf_id,'enum_total',etotal,err)
- ADIOS_WRITE_LBL(buf_id,'enum',enum,err)
- ADIOS_WRITE_LBL(buf_id,'eoff',eoffset,err)
- ADIOS_WRITE_LBL(buf_id,'enphase',ict2,err)
- ADIOS_WRITE_LBL(buf_id,'egid',egid,err)
- ADIOS_WRITE_LBL(buf_id,'ephase',ephase,err)
- endif
- ADIOS_CLOSE(buf_id,err)
-
- end subroutine
-
-
-#ifdef ADIOS2
- subroutine write_particles_adios2()
- use adios2_comm_module
- implicit none
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable), save :: vtimestep, vtime
- type(adios2_variable), save :: vigid, viphase
- type(adios2_variable), save :: vegid, vephase
- logical, save :: isfirst = .true.
- real :: timeout = 0.0
- integer :: istatus
-
- if(isfirst) then
- isfirst=.false.
- ! Note: have to check sml_istep not sml_gstep. istep starts from 0 at each run,
- ! gstep keeps increasing over restarts
- ! Definition of variables
- call adios2_declare_io(io, adios2obj, "particles2", err)
- call adios2_define_variable(vtimestep, io, "timestep", adios2_type_integer4, err)
- call adios2_define_variable(vtime, io, "time", adios2_type_dp, err)
-
- call adios2_define_variable(vigid, io, "igid", adios2_type_integer8, &
- 1, (/ itotal /), (/ ioffset /), (/ inum*1_8 /), .false., err)
- call adios2_define_variable(viphase, io, "iphase", adios2_type_real, &
- 2, (/ ict2*1_8,itotal /), (/ 0_8,ioffset /), (/ ict2*1_8,inum*1_8 /), .false., err)
-
- if(sml_electron_on) then
- call adios2_define_variable(vegid, io, "egid", adios2_type_integer8, &
- 1, (/ etotal /), (/ eoffset /), (/ enum*1_8 /), .false., err)
- call adios2_define_variable(vephase, io, "ephase", adios2_type_real, &
- 2, (/ ict2*1_8,etotal /), (/ 0_8,eoffset /), (/ ict2*1_8,enum*1_8 /), .false., err)
- endif
-
- if (adios_stage_particle) then
- if (sml_mype.eq.0) print *, 'ADIOS2: Open output particles to stream "', trim(filename), '"'
- ! Open once
- call adios2_open(engine, io, filename, adios2_mode_write, sml_comm, err)
- call adios2_comm_engine_push(engine)
- endif
- endif
-
- if (.not.adios_stage_particle) then
- if (sml_mype.eq.0) print *, 'ADIOS2: Write output particles to file "', trim(filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, sml_comm, err)
- endif
-
- if (sml_mype == 0) print *, 'ADIOS2: Write particles step:',sml_gstep
- call adios2_begin_step(engine, adios2_step_mode_append, 0.0, istatus, err)
-
- if (sml_mype == 0) then
- call adios2_put(engine, vtimestep, sml_gstep, err)
- call adios2_put(engine, vtime, sml_time, err)
- endif
-
- ! Number of Ions changes every step, so we need to modify the definition
- ! before writing
- call adios2_set_shape(vigid, 1, (/ itotal /), err)
- call adios2_set_selection(vigid, 1, (/ ioffset /), (/ inum*1_8 /), err)
- call adios2_put(engine, vigid, igid, err)
-
- call adios2_set_shape(viphase, 2, (/ ict2*1_8,itotal /), err)
- call adios2_set_selection(viphase, 2, (/ 0_8,ioffset /), (/ ict2*1_8,inum*1_8 /), err)
- call adios2_put(engine, viphase, iphase, err)
-
- if(sml_electron_on) then
- ! Number of electrons changes every step, so we need to modify the definition
- ! before writing
- call adios2_set_shape(vegid, 1, (/ etotal /), err)
- call adios2_set_selection(vegid, 1, (/ eoffset /), (/ enum*1_8 /), err)
- call adios2_put(engine, vegid, egid, err)
-
- call adios2_set_shape(vephase, 2, (/ ict2*1_8,etotal /), err)
- call adios2_set_selection(vephase, 2, (/ 0_8,eoffset /), (/ ict2*1_8,enum*1_8 /), err)
- call adios2_put(engine, vephase, ephase, err)
- endif
-
- call adios2_end_step(engine, err)
- if (.not.adios_stage_particle) then
- call adios2_close(engine, err)
- endif
-
- ! Engine will be closed in adios_comm_module/adios2_comm_finalize()
-
- end subroutine
-#endif
-
- subroutine count_num(isp,num)
- integer, intent(in) :: isp
- integer, intent(out) :: num
- integer :: i
- integer (8) :: gid1
-
- num=0 ! initialize
-
- do i=1, spall(isp)%num
- gid1=spall(isp)%ptl(i)%gid
- !if(gid1>0) then
- if(mod(gid1-1,diag_particle_mod)==0) then
- num=num+1
- endif
- !endif
- enddo
- end subroutine
-
- subroutine get_offset(num,offset,total)
- integer, intent(in) :: num
- integer (8), intent(out) :: offset, total
- integer :: err
- !
- integer*8 :: num8, inum_all(sml_intpl_totalpe) ! inum array per plane
- integer*8 :: inumsum, inumsum_all(sml_plane_totalpe) ! sum of inums in each plane
-
- ! two step mpi_allgather to avoid mpi_allgather in com_world
- num8 = num
- call mpi_allgather(num8,1,MPI_INTEGER8,inum_all,1,MPI_INTEGER8,sml_intpl_comm,err)
- inumsum = sum(inum_all)
- call mpi_allgather(inumsum,1,MPI_INTEGER8,inumsum_all,1,MPI_INTEGER8,sml_plane_comm,err)
- offset = sum(inumsum_all(1:sml_plane_mype)) + sum(inum_all(1:sml_intpl_mype)) !mype has zero base
- total = sum(inumsum_all)
- end subroutine
-
-
- subroutine prep_data(isp,num,phase,gid)
- integer, intent(in) :: isp, num
- real (4), intent(out) :: phase(ict2,num)
- integer (8), intent(out) :: gid(num)
- integer :: i,n
- integer (8) :: gid1
-
- !
- n=0 !initialize
-
- do i=1, spall(isp)%num
- gid1=spall(isp)%ptl(i)%gid
- !if(gid1>0) then
- if(mod(gid1-1,diag_particle_mod)==0) then
- n=n+1
- phase(1:ptl_nphase,n)=spall(isp)%ptl(i)%ph
- phase(ict1:ict2,n) =spall(isp)%ptl(i)%ct
- gid(n)=gid1
- endif
- !endif
- enddo
-
- end subroutine
-end subroutine diag_particle2
diff --git a/XGC1/es_main.F90 b/XGC1/es_main.F90
index 3413d26b..b2e157b8 100644
--- a/XGC1/es_main.F90
+++ b/XGC1/es_main.F90
@@ -28,7 +28,6 @@ program xgc1_3
use grid_class
use psn_class
use diag_module
- use diag_main_loop_module !perhaps combine with diag_module?
use smooth_module
use pol_decomp_module
use src_module
@@ -72,7 +71,6 @@ program xgc1_3
#else
use main_loop_module, only : main_loop
#endif
- use dcx_coupling_module
implicit none
type(grid_type), target :: grid
@@ -272,15 +270,7 @@ program xgc1_3
#ifdef USE_CAB_CPP
call main_loop(c_loc(grid),c_loc(psn),c_loc(spall))
#else
- if (dcx_side.eq.1) then
- if (sml_electron_on) then
- call diag_main_loop(grid,psn,spall(1)%shift_opt,spall(0)%shift_opt)
- else
- call diag_main_loop(grid,psn,spall(1)%shift_opt)
- endif
- else
- call main_loop(grid,psn,spall)
- endif
+ call main_loop(grid,psn,spall)
#endif
#if defined(DO_PARTICLE_CHECK) || defined(WRITE_PARTICLE_CHECK)
diff --git a/XGC1/es_poisson.F90 b/XGC1/es_poisson.F90
index b08dc9cf..586e4502 100644
--- a/XGC1/es_poisson.F90
+++ b/XGC1/es_poisson.F90
@@ -156,7 +156,7 @@ subroutine psn_init_poisson_private(psn,grid,nrhs)
isp_i = 1
if (sml_electron_on) then
isp_e = 0
- update_fac_te = merge(1D0,0D0,sml_update_poisson_solver)
+ if (sml_update_poisson_solver) update_fac_te = 1D0
else
isp_e = 1
update_fac_te = 0D0
@@ -1796,7 +1796,7 @@ subroutine solve_poisson_iter(grid,psn,iflag)
#else
if(iflag==1 .and. sml_electron_on) then
if(.not. sml_adjust_eden ) then
- dentmp=(psn%idensity0+f0_delta_n(:,1)) - (psn%edensity0+f0_delta_n(:,0))
+ dentmp=(psn%idensity0-f0_delta_n(:,1)) - (psn%edensity0+f0_delta_n(:,0))
else
dentmp=psn%idensity0 - psn%edensity0_adj
endif
diff --git a/XGC1/f0module.F90 b/XGC1/f0module.F90
index 1182a309..abad3a00 100644
--- a/XGC1/f0module.F90
+++ b/XGC1/f0module.F90
@@ -27,9 +27,6 @@ module f0_module
real (8), allocatable :: f0_f(:,:,:,:)
real (8), allocatable :: f0_df0g(:,:,:,:) !! stores the result of the collision operator
real (8), allocatable :: f0_df0g2(:,:,:,:) !! for giving df back to particles
- real (8), allocatable :: f0_f_save(:,:,:,:) !TODO: Remove to diag_fullf_turb? -RMC
- real (8), allocatable :: f0_T_ev_save(:,:) !TODO: Remove to diag_fullf_turb? -RMC
- real (8), allocatable :: f0_B_B0_save(:) !TODO: Remove to diag_fullf_turb? -RMC
#ifndef F_USE_MARKER_DEN2
real (8), allocatable :: f0_n(:,:,:,:) !! Normalization for mesh --> particle interpolation
#else
@@ -82,7 +79,6 @@ contains
subroutine f0_mem_allocation
use ptl_module
use assert_mod
- use diag_module, only : diag_fullf_turb_period
implicit none
integer :: alloc_stat
@@ -109,21 +105,6 @@ contains
call assert(alloc_stat .eq. 0, &
'alloc(f0_f) return istat=',alloc_stat)
- if (diag_fullf_turb_period>0) then
- if (allocated(f0_f_save)) deallocate(f0_f_save)
- allocate(f0_f_save(-f0_nvp:f0_nvp, &
- f0_inode1:f0_inode2,&
- f0_imu1:f0_imu2,&
- ptl_isp:ptl_nsp),stat=alloc_stat)
- if (allocated(f0_T_ev_save)) deallocate(f0_T_ev_save)
- allocate(f0_T_ev_save(f0_inode1:f0_inode2,&
- ptl_isp:ptl_nsp),stat=alloc_stat)
- if (allocated(f0_B_B0_save)) deallocate(f0_B_B0_save)
- allocate(f0_B_B0_save(f0_inode1:f0_inode2),stat=alloc_stat)
- call assert(alloc_stat .eq. 0, &
- 'alloc(f0_f) return istat=',alloc_stat)
- endif
-
if (allocated(f0_df0g)) deallocate(f0_df0g)
allocate(f0_df0g(-f0_nvp:f0_nvp, &
f0_inode1:f0_inode2,&
@@ -813,170 +794,6 @@ contains
end subroutine
-
-!> Interpolates a grid distribution function to real space, velocity space location given
- !> by node, mu_n,vp_n. In poloidal plane it uses nearest neighbor, in toroidal direction (if
- !> F0_TOR_LINEAR is defined) and velocity space linear interpolation.
- !> TK: I don't really understand where/how f0_f0g is defined. It looks like it contains
- !> two toroidal planes, but which two?
- !> f0_inode1 and f0_inode2 are the same for all threads of each mpi rank.
- !<
- subroutine f0_get_fgrid(grid,fgrid,B_B0,T_ev,inode1,inode2,isp,itr,p,phi,mu_n_in,vp_n,f0g,err)
- use omp_lib
- use sml_module, only : sml_mype
- use ptl_module
- use grid_class
- implicit none
- type(grid_type) :: grid
- integer, intent(in) :: inode1,inode2
- real (8),intent(inout) :: fgrid(-f0_nvp:f0_nvp,inode1:inode2,f0_imu1:f0_imu2,ptl_isp:ptl_nsp)
- real (8),intent(in) :: B_B0(inode1:inode2)
- real (8),intent(in) :: T_ev(inode1:inode2,ptl_isp:ptl_nsp)
- integer, intent(in) :: isp,itr
- real (8), intent(in) :: p(3)
- real (8), intent(in) :: phi, mu_n_in, vp_n
- real (8), intent(out) :: f0g
- logical, intent(out) :: err
- !
- real (8) :: mu_n ! v_perp^2
- integer :: i_mu, i_vp, ip, node, ml(1)
- real (8) :: wmu(0:1), wvp(0:1), smu, smu0, smu1
- logical, external :: is_nan
- real (8) :: wphi(0:1) ! for F0_TOR_LINEAR
-
- integer :: ith
-
- logical, parameter :: brief = .false.
-
-
- err = .false.
-
- !Set default value / initial value of f0g
- f0g = 0D0
-
- !exclude out-of-grid particle -- 1st
- if(itr<=0) then
- return ! zero f0g
- endif
-
- !find nearest node
- ml=maxloc(p)
- node= grid%nd(ml(1),itr)
- if(node < inode1 .or. node > inode2) then
- if(brief) then
- !ith = omp_get_thread_num()
- !print *, sml_mype,ith,'wrong particle ',f0_inode1,f0_inode2,node
- !stop
- else
- print *, 'wrong particle found, isp=',isp
- print *, 'f0_inode1, f0_inode2 f0_inode1_save f0_inode2_save node ', f0_inode1, f0_inode2, f0_inode1_save,f0_inode2_save,node
- print *, 'grid%nd',grid%nd(:,itr), itr
- print *, 'p', p
- print *, 'x from nd and p=', grid%x(:,grid%nd(1,itr))*p(1) + grid%x(:,grid%nd(2,itr))*p(2) + grid%x(:,grid%nd(3,itr))*p(3)
- print *, 'x1=', grid%x(:,grid%nd(1,itr)), p(1)
- print *, 'x2=', grid%x(:,grid%nd(2,itr)), p(2)
- print *, 'x3=', grid%x(:,grid%nd(3,itr)), p(3)
- err=.true.
- end if
- return
- else
- err=.false.
- endif
-
- !get mu_n (It is actually v_perp^2/vth^2)
- !when V_PERP is not defined, mu_n is 2*B(grid)*mu / T(particle)
-#ifndef V_PERP
- mu_n = mu_n_in*B_B0(node)
-#else
- mu_n = mu_n_in
-#endif
-
-
-#ifdef F0_TOR_LINEAR
- wphi(1)= phi/grid%delta_phi - grid%iphi_offset
- wphi(0)= 1D0 - wphi(1)
-#endif
-
- smu=sqrt(mu_n) ! square root mu
-
- wmu(0)=smu/f0_dsmu ! temp. variable - normalized sqrt(mu) with delta
- i_mu = floor(wmu(0)) ! get index for lower grid
- wmu(1)=wmu(0)-real(i_mu,8) ! wmu(1) is now weight for upper grid
- wmu(0)=1D0 - wmu(1) ! wmu(0) is now weight for lower grid
-
- if(i_mu==0) then
- smu0=f0_dsmu/f0_mu0_factor
- smu1=f0_dsmu
- elseif(i_mu==f0_nmu-1) then
- smu0=f0_dsmu*real(i_mu,8)
- smu1=f0_dsmu*(real(f0_nmu,8)-1D0/f0_mu0_factor)
- else
- smu0=f0_dsmu*real(i_mu,8)
- smu1=f0_dsmu*real(i_mu+1,8)
- endif
-
-
- wvp(0)=vp_n/f0_dvp
- i_vp= floor(wvp(0))
- wvp(1)=wvp(0)-real(i_vp,8)
- wvp(0)=1D0-wvp(1)
-
- !exclude out-of-grid particle - 2nd
- if(i_mu >= f0_nmu .or. i_vp >= f0_nvp .or. i_vp < -f0_nvp) then
- return ! zero f0g
- endif
-
- !sum-up
-
- ! This is for v_perp-v_parallel grid --->
-#ifndef F0_TOR_LINEAR
- f0g=f0g+ wmu(0)/(smu0)*wvp(0)*fgrid(i_vp+0,node,i_mu+0,isp)
- f0g=f0g+ wmu(0)/(smu0)*wvp(1)*fgrid(i_vp+1,node,i_mu+0,isp)
- f0g=f0g+ wmu(1)/(smu1)*wvp(0)*fgrid(i_vp+0,node,i_mu+1,isp)
- f0g=f0g+ wmu(1)/(smu1)*wvp(1)*fgrid(i_vp+1,node,i_mu+1,isp)
-#else
- f0g=f0g+ wmu(0)/(smu0)*wvp(0)*wphi(0)*fgrid(i_vp+0,node,i_mu+0,0,isp)
- f0g=f0g+ wmu(0)/(smu0)*wvp(1)*wphi(0)*fgrid(i_vp+1,node,i_mu+0,0,isp)
- f0g=f0g+ wmu(1)/(smu1)*wvp(0)*wphi(0)*fgrid(i_vp+0,node,i_mu+1,0,isp)
- f0g=f0g+ wmu(1)/(smu1)*wvp(1)*wphi(0)*fgrid(i_vp+1,node,i_mu+1,0,isp)
-
- f0g=f0g+ wmu(0)/(smu0)*wvp(0)*wphi(1)*fgrid(i_vp+0,node,i_mu+0,1,isp)
- f0g=f0g+ wmu(0)/(smu0)*wvp(1)*wphi(1)*fgrid(i_vp+1,node,i_mu+0,1,isp)
- f0g=f0g+ wmu(1)/(smu1)*wvp(0)*wphi(1)*fgrid(i_vp+0,node,i_mu+1,1,isp)
- f0g=f0g+ wmu(1)/(smu1)*wvp(1)*wphi(1)*fgrid(i_vp+1,node,i_mu+1,1,isp)
-#endif
- f0g=f0g/sqrt(T_ev(node,isp))
-
- if(is_nan(f0g)) then
- write(*,'(A,I2,I10,3(F10.3,1x),F10.3,F10.4,F10.4)') 'isp,node,p,phi,mu_n,vp_n=',isp,node,p,phi,mu_n,vp_n
- write(*,'(A,2(F10.3,1x),2(F10.3,1x),F10.3,F10.3)') 'wmu(0:1), wvp(0:1), smu0, smu1=',wmu(0:1), wvp(0:1), smu0, smu1
- print *,'node,f0_T_ev=',node,f0_T_ev(node,isp)
-#ifndef F0_TOR_LINEAR
- write(*, '(A,E10.3,E10.3,E10.3,E10.3)') 'fgrid(i_vp+0~1,node,i_mu+0~1,isp)', fgrid(i_vp+0,node,i_mu+0,isp), &
- fgrid(i_vp+1,node,i_mu+0,isp), &
- fgrid(i_vp+0,node,i_mu+1,isp), &
- fgrid(i_vp+1,node,i_mu+1,isp)
-
- ! conflict of memory access should not be harmfull - zeroing out
- call set_zero_for_nan(fgrid(i_vp+0,node,i_mu+0,isp))
- call set_zero_for_nan(fgrid(i_vp+1,node,i_mu+0,isp))
- call set_zero_for_nan(fgrid(i_vp+0,node,i_mu+1,isp))
- call set_zero_for_nan(fgrid(i_vp+1,node,i_mu+1,isp))
- f0g=0D0
-
-#else
-
- ! not implimented.
-#endif
- endif
-
- end subroutine f0_get_fgrid
-
-
-
-
-
-
#ifndef DIAG_NOISE
subroutine f0_update_f0g(grid,isp,itr,p,phi,mu_n,vp_n,df0g,df2,s1g, s2g, s1f, s2f,iflag)
#else
@@ -2412,7 +2229,6 @@ subroutine f_source(grid, psn, spall)
use src_module, only : src_narea, src_narea_e
use rad_module, only : rad_start_time
use omp_module, only: split_indices
- use diag_module, only : diag_fullf_turb_period
implicit none
type(grid_type), intent(in) :: grid
type(psn_type), intent(inout) :: psn
@@ -2421,7 +2237,7 @@ subroutine f_source(grid, psn, spall)
integer :: node, st
integer :: index_diag_f0_df
logical, save :: first=.true.
- integer :: i,err
+ integer :: i
interface
subroutine diag_f0(istep,grid,psn,flag)
@@ -2511,15 +2327,6 @@ subroutine f_source(grid, psn, spall)
call t_stopf("F_SYMMETRIC_F")
endif
-
- if (diag_fullf_turb_period>0) then
- call t_startf("DIAG_FULLF_TURB")
- call diag_fullf_turb(grid,psn,spall(1)%shift_opt,spall(0)%shift_opt)
- call t_stopf("DIAG_FULLF_TURB")
- call MPI_BARRIER(sml_comm,err)
- if (sml_mype==0) print *,'FINISHED DIAG_FULLF_TURB'
- endif
-
call t_startf("F_UPD_W_PTL2")
call update_w_ion(spall(1),1)
if(sml_electron_on) call update_w_elec(spall(0),1)
diff --git a/XGC1/neutral.F90 b/XGC1/neutral.F90
index febd4b6e..1d5dd624 100644
--- a/XGC1/neutral.F90
+++ b/XGC1/neutral.F90
@@ -784,9 +784,6 @@ contains
!
integer :: jth, iphi
real (8), external :: psi_interpol
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
if (first) then
allocate(n2ne00(grid%npsi00,sml_nthreads))
@@ -803,7 +800,6 @@ contains
call split_indices((sp%num-old_ptl_num), sml_nthreads, i_beg, i_end)
!!$OMP PARALLEL DO &
-!!$OMP SHARED ( n_removed_particles ), &
!!$OMP PRIVATE( ITH, I, IRHO, J, NODE, &
!!$OMP PHI, WPHI, PARTICLE_WEIGHT, WP, &
!!$OMP IP, X, PSI, PN )
@@ -851,7 +847,6 @@ contains
!eliminate particle
call remove_particle(sp,i,-1,ith)
- n_removed_particles = n_removed_particles + 1
endif
@@ -870,10 +865,6 @@ contains
enddo
psn%n2ne00_1d=n2ne00(:,1)
- if (n_removed_particles .gt. 0) then
- print *, "subroutine neutrale_scatter: n_removed_particles=", n_removed_particles
- endif
-
end subroutine neutrale_scatter
end subroutine neutrale
diff --git a/XGC1/pushi_sub.F90 b/XGC1/pushi_sub.F90
index 5ea9871d..d74864f1 100644
--- a/XGC1/pushi_sub.F90
+++ b/XGC1/pushi_sub.F90
@@ -95,9 +95,6 @@ subroutine pushi_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on)
integer :: ith, i_beg(sml_nthreads), i_end(sml_nthreads)
real (kind=8) , external :: psi_interpol
character (len=5) :: err_str(2)
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
err_str(1)='ion'
err_str(2)='elec'
@@ -109,7 +106,6 @@ subroutine pushi_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on)
dt_now=sml_dt*0.5D0/real(sml_ncycle_half)
!$OMP PARALLEL DO &
-!$OMP SHARED ( n_removed_particles ) &
!$OMP PRIVATE( ITH, I, NEW_PHASE, &
!$OMP OLD_PHASE, RTN )
do ith=1, sml_nthreads
@@ -131,8 +127,7 @@ subroutine pushi_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on)
! check r-z boundary validity and update psi variables
if(new_phase(1)<eq_min_r .or. new_phase(1)>eq_max_r .or. new_phase(2)<eq_min_z .or. new_phase(2)>eq_max_z)then
call remove_particle(sp,i,-1,ith)
- n_removed_particles = n_removed_particles + 1
- print *, 'particle eliminated due to rz_outside :', i, sml_mype, sp%type, sp%ptl(i)%gid, new_phase(1),new_phase(2)
+! print *, 'particle eliminated due to rz_outside :', i, sml_mype, sp%type, sp%ptl(i)%gid, new_phase(1),new_phase(2)
else
! bounce
!if(ipc==sml_nrk .and. sml_bounce/=0) then
@@ -141,7 +136,6 @@ subroutine pushi_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on)
call bounce(new_phase,old_phase,rtn)
if(rtn<0) then
call remove_particle(sp,i,-2,ith)
- n_removed_particles = n_removed_particles + 1
endif
endif
@@ -153,10 +147,6 @@ subroutine pushi_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on)
endif
endif
enddo
-
- if (n_removed_particles .gt. 0) then
- print *, "subroutine pushi_1step: n_removed_particles, " n_removed_particles
- endif
call t_stopf("PUSHI_LOOP")
enddo
diff --git a/XGC1/setup.F90 b/XGC1/setup.F90
index 4b98d2d6..2b02185b 100644
--- a/XGC1/setup.F90
+++ b/XGC1/setup.F90
@@ -1084,7 +1084,6 @@ subroutine read_input
#endif
use assert_mod
use coupling_module
- use dcx_coupling_module
use ptb_3db_module
use resamp_module
use coupling_core_edge
@@ -1257,8 +1256,7 @@ subroutine read_input
diag_heat_rmax3, diag_heat_rmin3, diag_heat_zmax3, diag_heat_zmin3, &
diag_heat_guess_table_size, &
diag_heat_mode, diag_heat_nphi, diag_heat_spacing, diag_poin_nrec, &
- diag_poin_isp, diag_col_convergence_stat_on, &
- diag_fullf_turb_period, diag_fullf_turb_start, diag_fullf_turb_ptl_num
+ diag_poin_isp, diag_col_convergence_stat_on
namelist /smooth_param/ smooth_mode_in, smooth_n_in, smooth_type_in, &
smooth_H_mode_in, smooth_H_n_in, smooth_H_type_in, &
@@ -1363,14 +1361,6 @@ subroutine read_input
namelist /cce_surfaces/ cce_surface_first_node,cce_surface_last_node
- namelist /dcx_coupling_param/ &
- dcx_side, dcx_f0_shared, dcx_step_offset, &
- dcx_f0_stage, dcx_write_f0_period, dcx_read_f0_period, &
- dcx_ff_stage, dcx_write_ff_period, dcx_read_ff_period, &
- dcx_mesh_stage, dcx_write_mesh_period, dcx_read_mesh_period, &
- dcx_particle_stage, dcx_write_particle_period, dcx_read_particle_period, &
- dcx_read_totalpe
-
! 0. reads input file into input file string
#ifndef USE_OLD_READ_INPUT
call read_input_file
@@ -2197,10 +2187,6 @@ subroutine read_input
diag_3d_period=diag_1d_period ! 3d_period is 1d_period
diag_f3d_period = max(1,(diag_f3d_period/sml_f_source_period)*sml_f_source_period)
- diag_fullf_turb_period = 0 !< Period in time steps for the full-f tracer diagnostic
- diag_fullf_turb_start = 10000 !< Time step to start full-f tracer diagnostic
- diag_fullf_turb_ptl_num = 10000 !< Number of full-f markers per spatial vertex for the full-f tracer diagnostic
-
! read diag_parameters
#ifdef USE_OLD_READ_INPUT
open(unit=14,file='input',action='read')
@@ -2689,18 +2675,6 @@ subroutine read_input
read(input_string(name_idx:len_trim(input_string)),nml=coupling_param)
!***************************************************************************
- ! dcx_coupling parameters ----------------------------------------------------
- call dcx_init()
- name_idx = read_namelist_index(input_string,"dcx_coupling_param")
- read(input_string(name_idx:len_trim(input_string)),nml=dcx_coupling_param)
- dcx_other = mod(dcx_side+1,2)
- if (sml_mype.eq.0) print *, 'dcx_side:', dcx_side
- if (sml_mype.eq.0) print *, 'dcx_step_offset:', dcx_step_offset
- if (sml_mype.eq.0) print *, 'dcx_f0_stage:', dcx_f0_stage
- if (sml_mype.eq.0) print *, 'dcx_ff_stage:', dcx_ff_stage
- if (sml_mype.eq.0) print *, 'dcx_mesh_stage:', dcx_mesh_stage
- if (sml_mype.eq.0) print *, 'dcx_particle_stage:', dcx_particle_stage
- !***************************************************************************
! resampling parameters ----------------------------------------------------
resamp_rate = 2*sml_f_source_period !< timesteps per resample
diff --git a/XGC_core/adios2_comm_mod.F90 b/XGC_core/adios2_comm_mod.F90
index e918518b..fcae741d 100644
--- a/XGC_core/adios2_comm_mod.F90
+++ b/XGC_core/adios2_comm_mod.F90
@@ -1,8 +1,11 @@
module adios2_comm_module
use sml_module
+#ifdef ADIOS2
use adios2
+#endif
implicit none
+#ifdef ADIOS2
type(adios2_adios) :: adios2obj
type(adios2_engine), allocatable :: list_engines(:)
integer :: n_engines
@@ -14,13 +17,6 @@ module adios2_comm_module
real(kind=8) :: t_start
interface adios2_comm_get_type
- module procedure adios2_comm_get_type_real
- module procedure adios2_comm_get_type_real_arr1d
- module procedure adios2_comm_get_type_real_arr2d
- module procedure adios2_comm_get_type_real_arr3d
- module procedure adios2_comm_get_type_real_arr4d
- module procedure adios2_comm_get_type_real_arr5d
- module procedure adios2_comm_get_type_real_arr6d
module procedure adios2_comm_get_type_dp
module procedure adios2_comm_get_type_dp_arr1d
module procedure adios2_comm_get_type_dp_arr2d
@@ -43,22 +39,6 @@ module adios2_comm_module
end interface
interface adios2_comm_define_variable
- module procedure adios2_comm_define_variable_real
- module procedure adios2_comm_define_variable_real_arr1d_auto
- module procedure adios2_comm_define_variable_real_arr2d_auto
- module procedure adios2_comm_define_variable_real_arr3d_auto
- module procedure adios2_comm_define_variable_real_arr4d_auto
- module procedure adios2_comm_define_variable_real_arr5d_auto
- module procedure adios2_comm_define_variable_real_arr1d
- module procedure adios2_comm_define_variable_real_arr2d
- module procedure adios2_comm_define_variable_real_arr3d
- module procedure adios2_comm_define_variable_real_arr4d
- module procedure adios2_comm_define_variable_real_arr5d
- module procedure adios2_comm_define_variable_real_arr1d_intd
- module procedure adios2_comm_define_variable_real_arr2d_intd
- module procedure adios2_comm_define_variable_real_arr3d_intd
- module procedure adios2_comm_define_variable_real_arr4d_intd
- module procedure adios2_comm_define_variable_real_arr5d_intd
module procedure adios2_comm_define_variable_dp
module procedure adios2_comm_define_variable_dp_arr1d_auto
module procedure adios2_comm_define_variable_dp_arr2d_auto
@@ -70,11 +50,6 @@ module adios2_comm_module
module procedure adios2_comm_define_variable_dp_arr3d
module procedure adios2_comm_define_variable_dp_arr4d
module procedure adios2_comm_define_variable_dp_arr5d
- module procedure adios2_comm_define_variable_dp_arr1d_intd
- module procedure adios2_comm_define_variable_dp_arr2d_intd
- module procedure adios2_comm_define_variable_dp_arr3d_intd
- module procedure adios2_comm_define_variable_dp_arr4d_intd
- module procedure adios2_comm_define_variable_dp_arr5d_intd
module procedure adios2_comm_define_variable_integer4
module procedure adios2_comm_define_variable_integer4_arr1d_auto
module procedure adios2_comm_define_variable_integer4_arr2d_auto
@@ -86,11 +61,6 @@ module adios2_comm_module
module procedure adios2_comm_define_variable_integer4_arr3d
module procedure adios2_comm_define_variable_integer4_arr4d
module procedure adios2_comm_define_variable_integer4_arr5d
- module procedure adios2_comm_define_variable_integer4_arr1d_intd
- module procedure adios2_comm_define_variable_integer4_arr2d_intd
- module procedure adios2_comm_define_variable_integer4_arr3d_intd
- module procedure adios2_comm_define_variable_integer4_arr4d_intd
- module procedure adios2_comm_define_variable_integer4_arr5d_intd
module procedure adios2_comm_define_variable_integer8
module procedure adios2_comm_define_variable_integer8_arr1d_auto
module procedure adios2_comm_define_variable_integer8_arr2d_auto
@@ -102,21 +72,9 @@ module adios2_comm_module
module procedure adios2_comm_define_variable_integer8_arr3d
module procedure adios2_comm_define_variable_integer8_arr4d
module procedure adios2_comm_define_variable_integer8_arr5d
- module procedure adios2_comm_define_variable_integer8_arr1d_intd
- module procedure adios2_comm_define_variable_integer8_arr2d_intd
- module procedure adios2_comm_define_variable_integer8_arr3d_intd
- module procedure adios2_comm_define_variable_integer8_arr4d_intd
- module procedure adios2_comm_define_variable_integer8_arr5d_intd
end interface
interface adios2_comm_define_local_var
- module procedure adios2_comm_define_local_var_real
- module procedure adios2_comm_define_local_var_real_arr1d
- module procedure adios2_comm_define_local_var_real_arr2d
- module procedure adios2_comm_define_local_var_real_arr3d
- module procedure adios2_comm_define_local_var_real_arr4d
- module procedure adios2_comm_define_local_var_real_arr5d
- module procedure adios2_comm_define_local_var_real_arr6d
module procedure adios2_comm_define_local_var_dp
module procedure adios2_comm_define_local_var_dp_arr1d
module procedure adios2_comm_define_local_var_dp_arr2d
@@ -240,62 +198,6 @@ contains
end if
end subroutine
- function adios2_comm_get_type_real(x) result(y)
- implicit none
- real(4), intent(in) :: x
- integer :: y
-
- y = adios2_type_real
- end function
-
- function adios2_comm_get_type_real_arr1d(x) result(y)
- implicit none
- real(4), intent(in) :: x(:)
- integer :: y
-
- y = adios2_type_real
- end function
-
- function adios2_comm_get_type_real_arr2d(x) result(y)
- implicit none
- real(4), intent(in) :: x(:,:)
- integer :: y
-
- y = adios2_type_real
- end function
-
- function adios2_comm_get_type_real_arr3d(x) result(y)
- implicit none
- real(4), intent(in) :: x(:,:,:)
- integer :: y
-
- y = adios2_type_real
- end function
-
- function adios2_comm_get_type_real_arr4d(x) result(y)
- implicit none
- real(4), intent(in) :: x(:,:,:,:)
- integer :: y
-
- y = adios2_type_real
- end function
-
- function adios2_comm_get_type_real_arr5d(x) result(y)
- implicit none
- real(4), intent(in) :: x(:,:,:,:,:)
- integer :: y
-
- y = adios2_type_real
- end function
-
- function adios2_comm_get_type_real_arr6d(x) result(y)
- implicit none
- real(4), intent(in) :: x(:,:,:,:,:,:)
- integer :: y
-
- y = adios2_type_real
- end function
-
function adios2_comm_get_type_dp(x) result(y)
implicit none
real(8), intent(in) :: x
@@ -449,84 +351,84 @@ contains
end function
!! adios2_comm_define_variable
- subroutine adios2_comm_define_variable_real(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_dp(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x
+ real(8), intent(in) :: x
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr1d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_dp_arr1d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:)
+ real(8), intent(in) :: x(:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr2d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_dp_arr2d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:)
+ real(8), intent(in) :: x(:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr3d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_dp_arr3d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:)
+ real(8), intent(in) :: x(:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr4d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_dp_arr4d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:)
+ real(8), intent(in) :: x(:,:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr5d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_dp_arr5d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:,:)
+ real(8), intent(in) :: x(:,:,:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr1d(&
+ subroutine adios2_comm_define_variable_dp_arr1d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:)
+ real(8), intent(in) :: x(:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -538,14 +440,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr2d(&
+ subroutine adios2_comm_define_variable_dp_arr2d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:)
+ real(8), intent(in) :: x(:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -557,14 +459,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr3d(&
+ subroutine adios2_comm_define_variable_dp_arr3d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:)
+ real(8), intent(in) :: x(:,:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -576,14 +478,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr4d(&
+ subroutine adios2_comm_define_variable_dp_arr4d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:)
+ real(8), intent(in) :: x(:,:,:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -595,14 +497,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr5d(&
+ subroutine adios2_comm_define_variable_dp_arr5d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:,:)
+ real(8), intent(in) :: x(:,:,:,:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -614,179 +516,84 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_real_arr1d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_real_arr2d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_real_arr3d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_real_arr4d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_real_arr5d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_dp(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer4(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x
+ integer(4), intent(in) :: x
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr1d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer4_arr1d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:)
+ integer(4), intent(in) :: x(:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr2d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer4_arr2d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:)
+ integer(4), intent(in) :: x(:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr3d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer4_arr3d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:)
+ integer(4), intent(in) :: x(:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr4d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer4_arr4d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:,:)
+ integer(4), intent(in) :: x(:,:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr5d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer4_arr5d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:,:,:)
+ integer(4), intent(in) :: x(:,:,:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
.true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr1d(&
+ subroutine adios2_comm_define_variable_integer4_arr1d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:)
+ integer(4), intent(in) :: x(:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -798,14 +605,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr2d(&
+ subroutine adios2_comm_define_variable_integer4_arr2d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:)
+ integer(4), intent(in) :: x(:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -817,14 +624,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr3d(&
+ subroutine adios2_comm_define_variable_integer4_arr3d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:)
+ integer(4), intent(in) :: x(:,:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -836,14 +643,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr4d(&
+ subroutine adios2_comm_define_variable_integer4_arr4d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:,:)
+ integer(4), intent(in) :: x(:,:,:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -855,14 +662,14 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr5d(&
+ subroutine adios2_comm_define_variable_integer4_arr5d(&
variable, io, name, x, &
shape_dims, start_dims, count_dims, &
is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:,:,:)
+ integer(4), intent(in) :: x(:,:,:,:,:)
integer(kind=8), dimension(:), intent(in) :: shape_dims
integer(kind=8), dimension(:), intent(in) :: start_dims
integer(kind=8), dimension(:), intent(in) :: count_dims
@@ -874,473 +681,118 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr1d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
+ subroutine adios2_comm_define_variable_integer8(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
+ integer(8), intent(in) :: x
integer, intent(out) :: ierr
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
+ call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr2d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr1d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
+ integer(8), intent(in) :: x(:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
+ .true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr3d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr2d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
+ integer(8), intent(in) :: x(:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
+ .true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr4d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr3d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
+ integer(8), intent(in) :: x(:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ .true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_dp_arr5d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr4d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- real(8), intent(in) :: x(:,:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
+ integer(8), intent(in) :: x(:,:,:,:)
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ .true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_integer4(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr5d_auto(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- integer(4), intent(in) :: x
+ integer(8), intent(in) :: x(:,:,:,:,:)
integer, intent(out) :: ierr
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), ierr)
+ call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
+ size(int(shape(x), kind=8)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
+ .true., ierr)
end subroutine
- subroutine adios2_comm_define_variable_integer4_arr1d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr1d(&
+ variable, io, name, x, &
+ shape_dims, start_dims, count_dims, &
+ is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:)
+ integer(8), intent(in) :: x(:)
+ integer(kind=8), dimension(:), intent(in) :: shape_dims
+ integer(kind=8), dimension(:), intent(in) :: start_dims
+ integer(kind=8), dimension(:), intent(in) :: count_dims
+ logical, intent(in) :: is_constant_dims
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
+ size(shape_dims), shape_dims, start_dims, count_dims, &
+ is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_integer4_arr2d_auto(variable, io, name, x, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr2d(&
+ variable, io, name, x, &
+ shape_dims, start_dims, count_dims, &
+ is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:)
+ integer(8), intent(in) :: x(:,:)
+ integer(kind=8), dimension(:), intent(in) :: shape_dims
+ integer(kind=8), dimension(:), intent(in) :: start_dims
+ integer(kind=8), dimension(:), intent(in) :: count_dims
+ logical, intent(in) :: is_constant_dims
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
+ size(shape_dims), shape_dims, start_dims, count_dims, &
+ is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_integer4_arr3d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr4d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr5d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr1d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr2d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr3d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr4d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:,:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr5d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:,:,:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr1d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr2d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr3d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr4d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer4_arr5d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(4), intent(in) :: x(:,:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr1d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr2d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr3d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr4d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr5d_auto(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), int(shape(x), kind=8), (/ 0_8, 0_8, 0_8, 0_8, 0_8 /), int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr1d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr2d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:)
- integer(kind=8), dimension(:), intent(in) :: shape_dims
- integer(kind=8), dimension(:), intent(in) :: start_dims
- integer(kind=8), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr3d(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
+ subroutine adios2_comm_define_variable_integer8_arr3d(&
+ variable, io, name, x, &
+ shape_dims, start_dims, count_dims, &
+ is_constant_dims, ierr)
type(adios2_variable), intent(out) :: variable
type(adios2_io), intent(in) :: io
character*(*), intent(in) :: name
@@ -1394,197 +846,7 @@ contains
is_constant_dims, ierr)
end subroutine
- subroutine adios2_comm_define_variable_integer8_arr1d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr2d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr3d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr4d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
- subroutine adios2_comm_define_variable_integer8_arr5d_intd(&
- variable, io, name, x, &
- shape_dims, start_dims, count_dims, &
- is_constant_dims, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- integer(8), intent(in) :: x(:,:,:,:,:)
- integer(kind=4), dimension(:), intent(in) :: shape_dims
- integer(kind=4), dimension(:), intent(in) :: start_dims
- integer(kind=4), dimension(:), intent(in) :: count_dims
- logical, intent(in) :: is_constant_dims
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(shape_dims), int(shape_dims, kind=8), int(start_dims, kind=8), int(count_dims, kind=8), &
- is_constant_dims, ierr)
- end subroutine
-
!! Local variables - used for unit test - ALS
- ! Real (4)
- subroutine adios2_comm_define_local_var_real(variable, io, name, x, ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), 1, adios2_null_dims, adios2_null_dims, (/ 1_8 /),.true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_local_var_real_arr1d(&
- variable, io, name, x, &
- ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_local_var_real_arr2d(&
- variable, io, name, x, &
- ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_local_var_real_arr3d(&
- variable, io, name, x, &
- ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_local_var_real_arr4d(&
- variable, io, name, x, &
- ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_local_var_real_arr5d(&
- variable, io, name, x, &
- ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
- subroutine adios2_comm_define_local_var_real_arr6d(&
- variable, io, name, x, &
- ierr)
- type(adios2_variable), intent(out) :: variable
- type(adios2_io), intent(in) :: io
- character*(*), intent(in) :: name
- real(4), intent(in) :: x(:,:,:,:,:,:)
- integer, intent(out) :: ierr
-
- call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
- .true., ierr)
- end subroutine
-
! Real (8)
subroutine adios2_comm_define_local_var_dp(variable, io, name, x, ierr)
type(adios2_variable), intent(out) :: variable
@@ -1606,7 +868,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1620,7 +882,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1634,7 +896,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1648,7 +910,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1662,7 +924,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1676,7 +938,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1701,7 +963,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1715,7 +977,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1729,7 +991,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1743,7 +1005,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1757,7 +1019,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1782,7 +1044,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1796,7 +1058,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1810,7 +1072,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1824,7 +1086,7 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
@@ -1838,8 +1100,9 @@ contains
integer, intent(out) :: ierr
call adios2_define_variable(variable, io, name, adios2_comm_get_type(x), &
- size(int(shape(x), kind=4)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
+ size(int(shape(x), kind=8)), adios2_null_dims, adios2_null_dims, int(shape(x), kind=8), &
.true., ierr)
end subroutine
+#endif
end module adios2_comm_module
diff --git a/XGC_core/adios_macro.h b/XGC_core/adios_macro.h
index 9a8a1087..42ae4eb9 100644
--- a/XGC_core/adios_macro.h
+++ b/XGC_core/adios_macro.h
@@ -38,27 +38,15 @@
#if defined(__PGI) && (__PGIC__<15) || defined(__GFORTRAN__)
#define ADIOS2_DEFINE(variable,io,var,err) \
call adios2_comm_define_variable(variable,io,'var'//char(0),var,err)
-#define ADIOS2_DEFINE_ATTR(attr,io,var,err) \
- call adios2_define_attribute(attr,io,'var'//char(0),var,err)
#else
#define ADIOS2_DEFINE(variable,io,var,err) \
call adios2_comm_define_variable(variable,io,#var//char(0),var,err)
-#define ADIOS2_DEFINE_ATTR(attr,io,var,err) \
- call adios2_define_attribute(attr,io,#var//char(0),var,err)
#endif
#define ADIOS2_DEFINE_LBL(variable,io,label,var,err) \
call adios2_comm_define_variable(variable,io,trim(label)//char(0),var,err)
-#define ADIOS2_GL_DEFINE_LBL(variable,io,label,var,shape,start,count,constdim,err) \
- call adios2_comm_define_variable(variable,io,trim(label)//char(0),var,shape,start,count,constdim,err)
-#define ADIOS2_DEFINE_ATTR_LBL(attr,io,label,var,err) \
- call adios2_define_attribute(attr,io,trim(label)//char(0),var,err)
-#define ADIOS2_GL_DEFINE(variable,io,label,dtype,ndim,shape,start,count,constdim,err) \
- call adios2_define_variable(variable,io,trim(label)//char(0),dtype,ndim,shape,start,count,constdim,err)
#define ADIOS2_OPEN(engine,io,file,mode,grp_comm,err) \
call adios2_open(engine,io,trim(file)//char(0),mode,grp_comm,err)
-#define ADIOS2_BEGIN_STEP(engine,err) \
- call adios2_begin_step(engine,adios2_step_mode_append,err)
#if defined(__PGI) && (__PGIC__<15) || defined(__GFORTRAN__)
#define ADIOS2_WRITE(engine,var,err) \
@@ -71,26 +59,6 @@
call adios2_put(engine,trim(label)//char(0),var,err)
#define ADIOS2_WRITE_LBL_SYNC(engine,label,var,err) \
call adios2_put(engine,trim(label)//char(0),var,adios2_mode_sync,err)
-#define ADIOS2_SELECT_AND_WRITE_LBL(engine,variable,io,label,var,start,count,err) \
- call adios2_inquire_variable(variable,io,label,err); \
- call adios2_set_selection(variable,size(int(count,kind=4)),int(start,kind=8),int(count,kind=8),err); \
- call adios2_put(engine,trim(label)//char(0),var,err)
-#define ADIOS2_SELECT_AND_WRITE_LBL_SYNC(engine,variable,io,label,var,start,count,err) \
- call adios2_inquire_variable(variable,io,label,err); \
- call adios2_set_selection(variable,size(int(count,kind=4)),int(start,kind=8),int(count,kind=8),err); \
- call adios2_put(engine,trim(label)//char(0),var,adios2_mode_sync,err)
-#define ADIOS2_SHAPE_AND_WRITE_LBL(engine,variable,io,label,var,gdim,start,count,err) \
- call adios2_inquire_variable(variable,io,label,err); \
- call adios2_set_shape(variable,size(int(count,kind=4)),int(gdim,kind=8),err); \
- call adios2_set_selection(variable,size(int(count,kind=4)),int(start,kind=8),int(count,kind=8),err); \
- call adios2_put(engine,trim(label)//char(0),var,err)
-#define ADIOS2_SHAPE_AND_WRITE_LBL_SYNC(engine,variable,io,label,var,gdim,start,count,err) \
- call adios2_inquire_variable(variable,io,label,err); \
- call adios2_set_shape(variable,size(int(count,kind=4)),int(gdim,kind=8),err); \
- call adios2_set_selection(variable,size(int(count,kind=4)),int(start,kind=8),int(count,kind=8),err); \
- call adios2_put(engine,trim(label)//char(0),var,adios2_mode_sync,err)
-#define ADIOS2_END_STEP(engine,err) \
- call adios2_end_step(engine,err)
#define ADIOS2_CLOSE(engine,err) \
call adios2_close(engine,err)
diff --git a/XGC_core/collision.F90 b/XGC_core/collision.F90
index 026aa1a1..2943025e 100644
--- a/XGC_core/collision.F90
+++ b/XGC_core/collision.F90
@@ -149,18 +149,6 @@ end subroutine collision1
subroutine scatr_one(ekin, pitch, massa, chargea, denb, tempb_ev, massb_au, chargeb_eu,&
accel, dt, ekmin, iflag2)
- ! This is the actual collision routine. Changes energy and pitch angle
- ! of a particle
- ! input parameters:
- ! ekin, pitch1: input and output parameters (ekin of particle and pitch angle)
- ! Test particle collision of a particle with maxwellian background. Linearized collision
- ! operation - we get delta-f of specias a colliding with maxwellian background of species b.
- ! accel - accelerated collision frquency. A factor multiplied to collision frequency,
- ! using this we can artificially accelerate the collisions.
- ! ekmin - minimum value for ekin after collisions.
- ! iflag2 - 1: perform only pitch-angle scattering. line 180.
- ! 2: perform only energy scattering
- ! 3: perform both, pitch angle and energy scattering
use sml_module, only : sml_ev2j
use random_xgc
IMPLICIT NONE
diff --git a/XGC_core/cpp/cpp_main_loop.cpp b/XGC_core/cpp/cpp_main_loop.cpp
index 753c7a87..91e79aae 100644
--- a/XGC_core/cpp/cpp_main_loop.cpp
+++ b/XGC_core/cpp/cpp_main_loop.cpp
@@ -426,11 +426,11 @@ extern "C" void cpp_main_loop(FortranPtr grid_fptr, FortranPtr psn_fptr, Fortran
// Restart write and coupling write
write_restart(grid_fptr,psn_fptr,spall_fptr,istep,final_istep);
- ierr = GPTLstop("MAIN_LOOP");
-
// Flush camtimers
flush_timers(istep);
+ ierr = GPTLstop("MAIN_LOOP");
+
if (istep >= final_istep) break;
}
diff --git a/XGC_core/dcx_coupling_mod.F90 b/XGC_core/dcx_coupling_mod.F90
deleted file mode 100644
index 145b52ad..00000000
--- a/XGC_core/dcx_coupling_mod.F90
+++ /dev/null
@@ -1,1370 +0,0 @@
-module dcx_coupling_module
- use sml_module
- use perf_monitor
- use main_extra, only : check_point
- implicit none
- !! dcx_step_offset: adjust istep with offset
- integer :: dcx_side, dcx_other, dcx_step_offset
- logical :: dcx_f0_stage, dcx_ff_stage, dcx_mesh_stage, dcx_particle_stage
-
- integer :: dcx_write_f0_period, dcx_read_f0_period
- integer :: dcx_write_ff_period, dcx_read_ff_period
- integer :: dcx_write_mesh_period, dcx_read_mesh_period
- integer :: dcx_write_particle_period, dcx_read_particle_period
- integer :: dcx_read_totalpe
- logical :: dcx_f0_shared, dcx_particle_shared
-contains
-
- subroutine dcx_init()
- implicit none
- call check_point('dcx_coupling_init')
-
- !! 0: core, 1: edge
- dcx_side = 0
- dcx_other = 1
- dcx_step_offset = 0
-
- dcx_f0_stage = .false.
- dcx_write_f0_period = 10000
- dcx_read_f0_period = 10000
-
- dcx_mesh_stage = .false.
- dcx_write_mesh_period = 10000
- dcx_read_mesh_period = 10000
-
- dcx_particle_stage = .false.
- dcx_write_particle_period = 10000
- dcx_read_particle_period = 10000
- dcx_read_totalpe = 0
-
- dcx_f0_shared = .false.
- dcx_particle_shared = .false.
- end subroutine dcx_init
-
- subroutine dcx_write_mesh(grid,psn)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module, only : ptl_isp, ptl_nsp
- use f0_module
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- !
- integer :: nnode
- integer :: err, istatus
- character (len=256) :: filename
-
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- type(adios2_attribute) :: att
-
- nnode=grid%nnode
- if (sml_mype.eq.0) then
- if (dcx_mesh_stage) then
- write(filename,'("../coupling/xgc.dcx.mesh.",i1.1,".bp")') dcx_side
- else
- write(filename,'("../coupling/xgc.dcx.mesh.",i1.1,".",i5.5,".",i2.2,".bp")') dcx_side, sml_gstep, sml_ipc
- endif
-
- if (isfirst) then
- isfirst=.false.
- ! Definition of variables
- if (sml_mype == 0) print *, 'DCX: write define variables for mesh'
- call adios2_declare_io(io, adios2obj, 'dcx.write.mesh', err)
- call adios2_comm_define_variable(var, io, 'pot0', psn%pot0, &
- (/ 1_8*nnode /), (/ 0_8 /), (/ 1_8*nnode /), .false., err)
-
- if (dcx_mesh_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write mesh to stream "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, MPI_COMM_SELF, err)
- call adios2_comm_engine_push(engine)
- endif
- endif
-
- if (.not.dcx_mesh_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write mesh to file "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, MPI_COMM_SELF, err)
- endif
- if (sml_mype.eq.0) print *, 'DCX: Write mesh begin step:', sml_gstep, sml_ipc
- call t_startf("ADIOS_WRITE_DCX_MESH")
- call adios2_begin_step(engine, adios2_step_mode_append, 0.0, istatus, err)
- if(err.ne.adios2_step_status_ok) then
- print *, 'Failed to begin step:', err
- endif
- call adios2_put(engine, 'pot0', psn%pot0, err)
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_WRITE_DCX_MESH")
- if (sml_mype.eq.0) print *, 'DCX: Write mesh end step:', sml_gstep, sml_ipc
- if (.not.dcx_mesh_stage) then
- call adios2_close(engine, err)
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.mesh.",i1.1,".",i5.5,".",i2.2,".bp.unlock")') dcx_side, sml_gstep, sml_ipc
- open(20, file=filename, status="unknown", action="write")
- close(20)
- endif
- endif
-
- endif
- end subroutine dcx_write_mesh
-
- subroutine dcx_read_mesh(grid,psn)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module, only : ptl_isp, ptl_nsp
- use f0_module
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- !
- integer :: nnode
- integer :: err, istatus
- character (len=256) :: filename
- real (8) :: pot0(grid%nnode)
-
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- type(adios2_attribute) :: att
- logical :: ex
-
- nnode=grid%nnode
- if (sml_mype.eq.0) then
- !! Wait lock
- if (.not.dcx_mesh_stage) then
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.mesh.",i1.1,".",i5.5,".",i2.2,".bp.unlock")') dcx_other, sml_gstep, sml_ipc
- ex=.false.
- do while(.not.ex)
- print *, 'Waiting: ', trim(filename)
- inquire(file=filename,EXIST=ex)
- call sleep(1)
- end do
- endif
- call mpi_barrier(MPI_COMM_SELF, err)
- endif
-
- if (dcx_mesh_stage) then
- write(filename,'("../coupling/xgc.dcx.mesh.",i1.1,".bp")') dcx_other
- else
- write(filename,'("../coupling/xgc.dcx.mesh.",i1.1,".",i5.5,".",i2.2,".bp")') dcx_other, sml_gstep, sml_ipc
- endif
-
- if (isfirst) then
- if (sml_mype.eq.0) print *, 'DCX: Reading mesh from stream ', trim(filename)
- call adios2_declare_io(io, adios2obj, "dcx.read.mesh", err)
- call adios2_open(engine, io, filename, adios2_mode_read, MPI_COMM_SELF, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- if (dcx_mesh_stage) then
- call adios2_comm_engine_push(engine)
- endif
- isfirst=.false.
- else
- if (.not.dcx_mesh_stage) then
- call adios2_remove_all_variables(io, err)
- call adios2_remove_all_attributes(io, err)
- call adios2_open(engine, io, filename, adios2_mode_read, MPI_COMM_SELF, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- endif
- endif
-
- if (sml_mype.eq.0) print *, "DCX: Read mesh begin step: ", sml_gstep, sml_ipc
- call t_startf("ADIOS_READ_DCX_MESH")
- call adios2_begin_step(engine, adios2_step_mode_read, -1.0, istatus, err)
- if(err.ne.0) then
- print *, 'Failed to begin step:', err
- stop
- endif
- if(istatus.ne.adios2_step_status_ok) then
- print *, 'Status error in begin step:', istatus
- stop
- endif
- call adios2_inquire_variable(var, io, 'pot0', err)
- call adios2_set_selection(var, 1, (/ 0_8 /), (/ 1_8*nnode /), err)
- call adios2_get(engine, var, pot0, err)
-
- if (sml_mype.eq.0) print *, "DCX: Read mesh end step: ", sml_gstep, sml_ipc
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_READ_DCX_MESH")
- if (err.eq.adios2_step_status_end_of_stream) then
- if (sml_mype.eq.0) print *, " Stream has terminated. Quit reader"
- elseif (err.eq.adios2_step_status_not_ready) then
- if (sml_mype.eq.0) print *, " Next step has not arrived for a while. Assume termination"
- endif
-
- if (.not.dcx_mesh_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Read close ', trim(filename)
- call adios2_close(engine, err)
- endif
- endif
- call mpi_bcast(pot0,nnode,mpi_real8,0,sml_comm,err)
- end subroutine dcx_read_mesh
-
- subroutine dcx_write_f0(grid,psn)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module, only : ptl_isp, ptl_nsp
- use f0_module
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- !
- integer :: i
- integer :: nnode, inode1m1, ndata
- integer :: nphi, iphi
- integer :: nmup1, imu1m1, mudata
- integer :: vpdata
- character (len=256) :: filename
- integer*8 :: buf_id, buf_size, total_size
- integer :: adios_comm, adios_comm_totalpe, adios_comm_mype
- integer :: err, istatus
- integer, parameter :: nspace=2
- character (len=256) :: pathname
- character (len=256) :: labelname
- real (8) :: iden_f0_approx(f0_inode1:f0_inode2), tmp(f0_inode1:f0_inode2)
- real (4), allocatable :: tmp_f_real4(:,:,:,:)
-#ifndef F0_TOR_LINEAR
- real (4), allocatable :: tmp_g_real4(:,:,:,:)
-#else
- real (4), allocatable :: tmp_g_real4(:,:,:,:,:)
-#endif
- logical, parameter :: use_real4=.false.
- integer, parameter :: rsize=8
- integer :: lshape(4)
-
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- type(adios2_attribute) :: att
-
- nnode=grid%nnode
- inode1m1=f0_inode1-1
- ndata=f0_inode2-f0_inode1+1
-
- nphi=sml_nphi_total
- iphi=sml_intpl_mype
-
- nmup1= f0_nmu+1 ! include 0 index
- imu1m1=f0_imu1 -1 +1 ! additional +1 due to 0 starting index
- mudata=f0_imu2-f0_imu1+1
-
- vpdata=f0_nvp*2+1
- if (dcx_f0_stage) then
- write(filename,'("../coupling/xgc.dcx.f0.",i1.1,".bp")') dcx_side
- else
- write(filename,'("../coupling/xgc.dcx.f0.",i1.1,".",i5.5,".bp")') dcx_side, sml_gstep
- endif
- adios_comm = sml_comm
- adios_comm_totalpe = sml_totalpe
- adios_comm_mype = sml_mype
-
- if(sml_turb_poisson) then
-#ifndef F0_TOR_LINEAR
- tmp=sum(psn%iden_rho_f0(f0_inode1:f0_inode2,:),2)
-#else
- tmp=sum(psn%iden_rho_f0(f0_inode1:f0_inode2,1,:),2)
-#endif
- iden_f0_approx=tmp ! mpi reduce
-
- if (isfirst) then
- isfirst=.false.
- ! Definition of variables
- if (sml_mype == 0) print *, 'DCX: write define variables for f0'
- call adios2_declare_io(io, adios2obj, 'dcx.write.f0', err)
- call adios2_comm_define_variable(var, io, 'nnode', nnode, err)
- call adios2_comm_define_variable(var, io, 'inode1m1', inode1m1, err)
- call adios2_comm_define_variable(var, io, 'ndata', ndata, err)
- call adios2_comm_define_variable(var, io, 'nphi', nphi, err)
- call adios2_comm_define_variable(var, io, 'iphi', iphi, err)
-
- call adios2_comm_define_variable(var, io, 'nmup1', nmup1, err)
- call adios2_comm_define_variable(var, io, 'imu1m1', imu1m1, err)
- call adios2_comm_define_variable(var, io, 'mudata', mudata, err)
- call adios2_comm_define_variable(var, io, 'vpdata', vpdata, err)
-
- call adios2_define_variable(var, io, 'lshape', adios2_type_integer4, 3, &
- (/ 4_8,1_8*sml_pe_per_plane,1_8*nphi /), &
- (/ 0_8,1_8*sml_plane_mype,1_8*iphi /), &
- (/ 4_8,1_8,1_8 /), &
- .true., err)
-
- call adios2_comm_define_variable(var, io, 'iden_f0_approx', iden_f0_approx, &
- (/ 1_8*nnode,1_8*nphi /), &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- .false., err)
- if (sml_electron_on) then
-#ifndef F0_TOR_LINEAR
- call adios2_comm_define_variable(var, io, 'eden_f0', psn%eden_f0(f0_inode1:f0_inode2), &
- (/ 1_8*nnode,1_8*nphi /), &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- .false., err)
-#else
- call adios2_comm_define_variable(var, io, 'eden_f0', psn%eden_f0(f0_inode1:f0_inode2,1), &
- (/ 1_8*nnode,1_8*nphi /), &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- .false., err)
-#endif
- endif
-
- ! f data
- if(.not. use_real4) then
-#ifndef F0_TOR_LINEAR
- call adios2_comm_define_variable(var, io, 'i_f0g', f0_f0g(:,:,:,1), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
-#else
- call adios2_comm_define_variable(var, io, 'i_f0g', f0_f0g(:,:,:,0,1), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
- call adios2_comm_define_variable(var, io, 'i_f0g1', f0_f0g(:,:,:,1,1), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
-#endif
- !! Summary:
- !! global: vpdata, nnode, nmup1, nphi
- !! offset: 0, inode1m1, imu1m1, iphi
- !! size: vpdata, ndata, mudata, 1
- call adios2_comm_define_variable(var, io, 'i_f', f0_f(:,:,:,1), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
- call adios2_comm_define_variable(var, io, 'dpot', psn%dpot(f0_inode1:f0_inode2,1), &
- (/ 1_8*nnode,1_8*nphi /), &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- .false., err)
-
- if(sml_electron_on) then
-#ifndef F0_TOR_LINEAR
- call adios2_comm_define_variable(var, io, 'e_f0g', f0_f0g(:,:,:,0), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
-#else
- call adios2_comm_define_variable(var, io, 'e_f0g', f0_f0g(:,:,:,0,0), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
- call adios2_comm_define_variable(var, io, 'e_f0g1', f0_f0g(:,:,:,1,0), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
-#endif
- call adios2_comm_define_variable(var, io, 'e_f', f0_f(:,:,:,0), &
- (/ 1_8*vpdata,1_8*nnode,1_8*nmup1,1_8*nphi /), &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- .false., err)
- endif
- else
- print *, 'diag_f0: not implemented yet'
- endif
-
- if (dcx_f0_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write f0 to stream "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, adios_comm, err)
- call adios2_comm_engine_push(engine)
- endif
- endif
-
- if (.not.dcx_f0_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write f0 to file "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, adios_comm, err)
- endif
- if (sml_mype.eq.0) print *, 'DCX: Write f0 begin step:', sml_gstep
- call t_startf("ADIOS_WRITE_DCX_F0")
- call adios2_begin_step(engine, adios2_step_mode_append, 0.0, istatus, err)
- if(err.ne.adios2_step_status_ok) then
- print *, 'Failed to begin step:', err
- endif
- ! inode1m1 and ndata can change every step, so we need to modify the definition
- ! before writing by calling adios2_set_selection
- call adios2_put(engine, 'nnode', nnode, err)
- call adios2_put(engine, 'inode1m1', inode1m1, err)
- call adios2_put(engine, 'ndata', ndata, err)
- call adios2_put(engine, 'nphi', nphi, err)
- call adios2_put(engine, 'iphi', iphi, err)
- call adios2_put(engine, 'nmup1', nmup1, err)
- call adios2_put(engine, 'imu1m1', imu1m1, err)
- call adios2_put(engine, 'mudata', mudata, err)
- call adios2_put(engine, 'vpdata', vpdata, err)
-
- call adios2_inquire_variable(var, io, 'iden_f0_approx', err)
- call adios2_set_selection(var, 2, &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- err)
- call adios2_put(engine, var, iden_f0_approx, err)
-
- lshape = (/ inode1m1,ndata,imu1m1,mudata /)
- call adios2_put(engine, 'lshape', lshape, err)
-
- if(sml_electron_on)then
-#ifndef F0_TOR_LINEAR
- call adios2_inquire_variable(var, io, 'eden_f0', err)
- call adios2_set_selection(var, 2, &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- err)
- call adios2_put(engine, 'eden_f0', psn%eden_f0(f0_inode1:f0_inode2), err)
-#else
- call adios2_inquire_variable(var, io, 'eden_f0', err)
- call adios2_set_selection(var, 2, &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- err)
- call adios2_put(engine, 'eden_f0', psn%eden_f0(f0_inode1:f0_inode2,1), err)
-#endif
- endif
- ! f data
- if(.not. use_real4) then
-#ifndef F0_TOR_LINEAR
- call adios2_inquire_variable(var, io, 'i_f0g', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'i_f0g', f0_f0g(:,:,:,1), err)
-#else
- call adios2_inquire_variable(var, io, 'i_f0g', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'i_f0g', f0_f0g(:,:,:,0,1), err)
- call adios2_inquire_variable(var, io, 'i_f0g1', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'i_f0g1', f0_f0g(:,:,:,1,1), err)
-#endif
- call adios2_inquire_variable(var, io, 'i_f', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'i_f', f0_f(:,:,:,1), err)
- call adios2_inquire_variable(var, io, 'dpot', err)
- call adios2_set_selection(var, 2, &
- (/ 1_8*inode1m1,1_8*iphi /), &
- (/ 1_8*ndata,1_8 /), &
- err)
- call adios2_put(engine, 'dpot', psn%dpot(f0_inode1:f0_inode2,1), err)
-
- if(sml_electron_on) then
-#ifndef F0_TOR_LINEAR
- call adios2_inquire_variable(var, io, 'e_f0g', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'e_f0g', f0_f0g(:,:,:,0), err)
-#else
- call adios2_inquire_variable(var, io, 'e_f0g', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'e_f0g', f0_f0g(:,:,:,0,0), err)
- call adios2_inquire_variable(var, io, 'e_f0g1', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'e_f0g1', f0_f0g(:,:,:,1,0), err)
-#endif
- call adios2_inquire_variable(var, io, 'e_f', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*inode1m1,1_8*imu1m1,1_8*iphi /), &
- (/ 1_8*vpdata,1_8*ndata,1_8*mudata,1_8 /), &
- err)
- call adios2_put(engine, 'e_f', f0_f(:,:,:,0), err)
- endif
- endif
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_WRITE_DCX_F0")
- if (sml_mype.eq.0) print *, 'DCX: Write f0 end step:', sml_gstep
- !print *, sml_mype, 'dcx_write_f0:i_f', shape(f0_f(:,:,:,1)), sum(f0_f(:,:,:,1))
- !print *, sml_mype, 'dcx_write_f0:e_f', shape(f0_f(:,:,:,0)), sum(f0_f(:,:,:,0))
- if (.not.dcx_f0_stage) then
- call adios2_close(engine, err)
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.f0.",i1.1,".",i5.5,".bp.unlock")') dcx_side, sml_gstep
- open(20, file=filename, status="unknown", action="write")
- close(20)
- endif
- endif
- endif
- end subroutine dcx_write_f0
-
- subroutine dcx_read_f0(grid,psn)
- use psn_class
- use sml_module
- use ptl_module, only : ptl_isp, ptl_nsp
- use f0_module
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- integer :: n_n, ndata, inode1m1, nsp
- integer :: nphi, iphi
- integer :: nnode
- integer :: nmup1, imu1m1
- integer :: mudata, vpdata
- ! Adios2
- character(512) :: filename
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- integer :: err, istatus
- logical :: ex
- !! temp
- real (8), allocatable :: tmp_i_f(:,:,:,:), tmp_e_f(:,:,:,:)
- real (8), allocatable :: tmp_i_f0g(:,:,:,:), tmp_e_f0g(:,:,:,:)
- integer :: lshape(4)
-
- !! Wait lock
- if (.not.dcx_f0_stage) then
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.f0.",i1.1,".",i5.5,".bp.unlock")') dcx_other, sml_gstep
- ex=.false.
- do while(.not.ex)
- print *, 'Waiting: ', trim(filename)
- inquire(file=filename,EXIST=ex)
- call sleep(1)
- end do
- endif
- call mpi_barrier(sml_comm, err)
- endif
-
- !!read from xgc.f0.XXXXX.bp
- if (dcx_f0_stage) then
- write(filename,'("../coupling/xgc.dcx.f0.",i1.1,".bp")') dcx_other
- else
- write(filename,'("../coupling/xgc.dcx.f0.",i1.1,".",i5.5,".bp")') dcx_other, sml_gstep
- endif
-
- if (isfirst) then
- if (sml_mype.eq.0) print *, 'DCX: Reading f0 from stream ', trim(filename)
- call adios2_declare_io(io, adios2obj, "dcx.read.f0", err)
- call adios2_open(engine, io, filename, adios2_mode_read, sml_comm, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- if (dcx_f0_stage) then
- call adios2_comm_engine_push(engine)
- endif
- isfirst=.false.
- else
- if (.not.dcx_f0_stage) then
- call adios2_remove_all_variables(io, err)
- call adios2_remove_all_attributes(io, err)
- call adios2_open(engine, io, filename, adios2_mode_read, sml_comm, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- endif
- endif
-
- nnode=grid%nnode
- inode1m1=f0_inode1-1
- ndata=f0_inode2-f0_inode1+1
- nsp=ptl_nsp-ptl_isp+1
-
- nphi=sml_nphi_total
- iphi=sml_intpl_mype
-
- nmup1= f0_nmu+1 ! include 0 index
- imu1m1=f0_imu1 -1 +1 ! additional +1 due to 0 starting index
- mudata=f0_imu2-f0_imu1+1
-
- vpdata=f0_nvp*2+1
- !!jyc: we cannot do this due to load balancing in writer side.
- !print *, sml_mype, 'f0 Read(step,offset,ndata):', sml_gstep, inode1m1, ndata
- !allocate(tmp_i_f(1_8*vpdata,1_8*ndata,1_8*mudata,1_8), &
- ! tmp_e_f(1_8*vpdata,1_8*ndata,1_8*mudata,1_8))
- lshape = (/ inode1m1, ndata, imu1m1, mudata /)
-
- if (sml_mype.eq.0) print *, "DCX: Read f0 begin step: ", sml_gstep
- call t_startf("ADIOS_READ_DCX_F0")
- call adios2_begin_step(engine, adios2_step_mode_read, -1.0, istatus, err)
- if(err.ne.0) then
- print *, 'Failed to begin step:', err
- stop
- endif
- if(istatus.ne.adios2_step_status_ok) then
- print *, 'Status error in begin step:', istatus
- stop
- endif
-
- if (dcx_f0_shared) then
- call adios2_inquire_variable(var, io, 'lshape', err)
- call adios2_set_selection(var, 3, &
- (/ 0_8,1_8*sml_plane_mype,1_8*iphi /), &
- (/ 4_8,1_8,1_8 /), err)
- call adios2_get(engine, var, lshape, err)
- call adios2_perform_gets(engine, err)
- endif
-
- !print *, sml_mype, 'f0 Read(step,offset,ndata):', sml_gstep, lshape(1), lshape(2)
- allocate(tmp_i_f(1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8), &
- tmp_e_f(1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8))
- allocate(tmp_i_f0g(1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8), &
- tmp_e_f0g(1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8))
-
- call adios2_inquire_variable(var, io, 'i_f', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*lshape(1),1_8*lshape(3),1_8*iphi /), &
- (/ 1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8 /), err)
- call adios2_get(engine, var, tmp_i_f, err)
-
- !call adios2_inquire_variable(var, io, 'i_f0g', err)
- !call adios2_set_selection(var, 4, &
- ! (/ 0_8,1_8*lshape(1),1_8*lshape(3),1_8*iphi /), &
- ! (/ 1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8 /), err)
- !call adios2_get(engine, var, tmp_i_f0g, err)
-
- if (sml_electron_on) then
- call adios2_inquire_variable(var, io, 'e_f', err)
- if(err.eq.0) then
- call adios2_set_selection(var, 4, &
- (/ 0_8,1_8*lshape(1),1_8*lshape(3),1_8*iphi /), &
- (/ 1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8 /), err)
- call adios2_get(engine, var, tmp_e_f, err)
- endif
- !call adios2_inquire_variable(var, io, 'e_f0g', err)
- !if(err.eq.0) then
- ! call adios2_set_selection(var, 4, &
- ! (/ 0_8,1_8*lshape(1),1_8*lshape(3),1_8*iphi /), &
- ! (/ 1_8*vpdata,1_8*lshape(2),1_8*lshape(4),1_8 /), err)
- ! call adios2_get(engine, var, tmp_e_f0g, err)
- !endif
- endif
-
- if (sml_mype.eq.0) print *, "DCX: Read f0 end step: ", sml_gstep
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_READ_DCX_F0")
- if (err.eq.adios2_step_status_end_of_stream) then
- if (sml_mype.eq.0) print *, " Stream has terminated. Quit reader"
- elseif (err.eq.adios2_step_status_not_ready) then
- if (sml_mype.eq.0) print *, " Next step has not arrived for a while. Assume termination"
- endif
-
- f0_f(:,:,:,1)=tmp_i_f(:,:,:,1)
- !f0_f0g(:,:,:,1)=tmp_i_f0g(:,:,:,1)
- if (sml_electron_on) then
- f0_f(:,:,:,0)=tmp_e_f(:,:,:,1)
- !f0_f0g(:,:,:,0)=tmp_i_f0g(:,:,:,1)
- endif
- !print *, sml_mype, 'i_f', shape(f0_f(:,:,:,1)), sum(f0_f(:,:,:,1))
- !if (sml_electron_on) print *, sml_mype, 'e_f', shape(f0_f(:,:,:,0)), sum(f0_f(:,:,:,0))
-
- deallocate(tmp_i_f,tmp_e_f,tmp_i_f0g,tmp_e_f0g)
-
- if (.not.dcx_f0_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Read close ', trim(filename)
- call adios2_close(engine, err)
- endif
-
- end subroutine dcx_read_f0
-
- subroutine dcx_write_particle(spall,grid,psn)
- use f0_module
- use sml_module
- use ptl_module
- use psn_class
- use grid_class
- use sheath_module, only: sheath_nphi, sheath_pot
- use adios2_comm_module
- implicit none
- type(species_type):: spall(0:ptl_nsp_max)
- type(grid_type) :: grid
- type(psn_type):: psn
- integer :: i,j
- character (len=50) :: filename, dirname
- integer*8 :: buf_id, buf_size, total_size
- integer :: err, istatus
- real*8 start_time, end_time !SAK added this for timers
- integer :: np
- real (8), allocatable :: phase(:,:), ephase(:,:)
- integer (8), allocatable :: gid(:), egid(:)
- integer, parameter :: ict1=ptl_nphase+1
- integer, parameter :: ict2=ptl_nphase+ptl_nconst
- !
- ! f0 grid
- integer :: nnode, inode1m1
- integer :: nmup1, imu1m1
- integer :: ndata, mudata, vpdata
- integer :: ntor, nvar
-
- integer*8 :: inum_total, ioff, enum_total, eoff, inum, enum
- integer*8 :: inum_all(sml_totalpe), enum_all(sml_totalpe)
-
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable), save :: vigid, viphase
- type(adios2_variable), save :: vegid, vephase
- type(adios2_variable) :: var
- integer :: dummyint4(1)
- integer*8 :: dummyint8(1)
- real :: timeout = 0.0
- integer :: adios_comm, adios_comm_totalpe, adios_comm_mype
-
- np=spall(1)%num
- allocate(phase(ict2,np),gid(np))
- ! copy to temp memory
-
- do i=1, np
- phase(1:ptl_nphase,i)=spall(1)%ptl(i)%ph
- phase(ict1:ict2,i)=spall(1)%ptl(i)%ct
- gid(i)=spall(1)%ptl(i)%gid
- enddo
-
- if(sml_electron_on)then
- np=spall(0)%num
- allocate(ephase(ict2,np),egid(np))
- ! copy to temp. memory
- do i=1, np
- ephase(1:ptl_nphase,i)=spall(0)%ptl(i)%ph
- ephase(ict1:ict2 ,i)=spall(0)%ptl(i)%ct
- egid(i)=spall(0)%ptl(i)%gid
- enddo
- endif
-
- inum = spall(1)%num
- call mpi_allgather(inum,1,MPI_INTEGER8,inum_all,1,MPI_INTEGER8,sml_comm,err)
- inum_total = sum(inum_all)
- ioff = sum(inum_all(1:(sml_mype+1)))-spall(1)%num
- if(sml_electron_on)then
- enum = spall(0)%num
- call mpi_allgather(enum,1,MPI_INTEGER8,enum_all,1,MPI_INTEGER8,sml_comm,err)
- enum_total = sum(enum_all)
- eoff = sum(enum_all(1:(sml_mype+1)))-spall(0)%num
- endif
-
- if (dcx_particle_stage) then
- write(filename,'("../coupling/xgc.dcx.particle.",i1.1,".bp")') dcx_side
- else
- write(filename,'("../coupling/xgc.dcx.particle.",i1.1,".",i5.5,".bp")') dcx_side, sml_gstep
- endif
- adios_comm = sml_comm
- adios_comm_totalpe = sml_totalpe
- adios_comm_mype = sml_mype
-
- if (isfirst) then
- isfirst=.false.
- ! Definition of variables
- call adios2_declare_io(io, adios2obj, "dcx.write.particle", err)
- call adios2_define_variable(var, io, "timestep", adios2_type_integer4, err)
- call adios2_define_variable(var, io, "time", adios2_type_dp, err)
-
- if (sml_sheath_mode==1) then
- call adios2_define_variable(var, io, 'sheath_nwall',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'sheath_nphi',adios2_type_integer4,err)
- !jyc need to check: is it global?
- call adios2_define_variable(var, io, 'sheath_pot', adios2_type_dp, &
- 2, (/ grid%nwall*1_8, sheath_nphi*1_8 /), (/ 0_8, 0_8 /), (/ grid%nwall*1_8, sheath_nphi*1_8 /), .false., err)
- call adios2_define_variable(var, io, 'sheath_lost_cumul', adios2_type_dp, &
- 1, (/ grid%nwall*1_8 /), (/ 0_8 /), (/ grid%nwall*1_8 /), .false., err)
- endif
- ! ion
- call adios2_define_variable(var, io, 'maxnum',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'inum',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'inphase',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'imaxgid',adios2_type_integer8,err)
-
- call adios2_define_variable(var, io, 'inum_total',adios2_type_integer8,err)
- call adios2_define_variable(var, io, 'ioff',adios2_type_integer8,err)
- call adios2_define_variable(var, io, 'totalpe',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'mype',adios2_type_integer4,err)
-
- call adios2_define_variable(vigid, io, "igid", adios2_type_integer8, &
- 1, (/ inum_total /), (/ ioff /), (/ inum*1_8 /), .false., err)
- call adios2_define_variable(viphase, io, "iphase", adios2_type_dp, &
- 2, (/ ict2*1_8,inum_total /), (/ 0_8,ioff /), (/ ict2*1_8,inum*1_8 /), .false., err)
-
- call adios2_define_variable(var, io, 'inum_arr', adios2_type_integer4, &
- 1, (/ adios_comm_totalpe*1_8 /), (/ adios_comm_mype*1_8 /), (/ 1_8 /), .true., err)
- call adios2_define_variable(var, io, 'ioff_arr', adios2_type_integer8, &
- 1, (/ adios_comm_totalpe*1_8 /), (/ adios_comm_mype*1_8 /), (/ 1_8 /), .true., err)
-
- if(sml_electron_on)then
- call adios2_define_variable(var, io, 'enum',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'enphase',adios2_type_integer4,err)
- call adios2_define_variable(var, io, 'emaxgid',adios2_type_integer8,err)
-
- call adios2_define_variable(var, io, 'enum_total',adios2_type_integer8,err)
- call adios2_define_variable(var, io, 'eoff',adios2_type_integer8,err)
- call adios2_define_variable(vegid, io, "egid", adios2_type_integer8, &
- 1, (/ enum_total /), (/ eoff /), (/ enum*1_8 /), .false., err)
- call adios2_define_variable(vephase, io, "ephase", adios2_type_dp, &
- 2, (/ ict2*1_8,enum_total /), (/ 0_8,eoff /), (/ ict2*1_8,enum*1_8 /), .false., err)
-
- call adios2_define_variable(var, io, 'enum_arr', adios2_type_integer4, &
- 1, (/ adios_comm_totalpe*1_8 /), (/ adios_comm_mype*1_8 /), (/ 1_8 /), .true., err)
- call adios2_define_variable(var, io, 'eoff_arr', adios2_type_integer8, &
- 1, (/ adios_comm_totalpe*1_8 /), (/ adios_comm_mype*1_8 /), (/ 1_8 /), .true., err)
- endif
-
- if (dcx_particle_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write particle to stream "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, adios_comm, err)
- call adios2_comm_engine_push(engine)
- endif
- endif
-
- if (.not.dcx_particle_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write particle to file "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, adios_comm, err)
- endif
- if (sml_mype.eq.0) print *, 'DCX: Write particle begin step:', sml_gstep
- call t_startf("ADIOS_WRITE_DCX_PARTICLE")
- call adios2_begin_step(engine, adios2_step_mode_append, 0.0, istatus, err)
- if(err.ne.adios2_step_status_ok) then
- print *, 'Failed to begin step:', err
- endif
-
- ! ion
- call adios2_put(engine, 'maxnum',spall(1)%maxnum,err)
- call adios2_put(engine, 'inum',spall(1)%num,err)
- call adios2_put(engine, 'inphase',ict2,err)
- call adios2_put(engine, 'imaxgid',spall(1)%maxgid,err)
- call adios2_put(engine, 'inum_total',inum_total,err)
- call adios2_put(engine, 'ioff',ioff,err)
- call adios2_put(engine, 'totalpe',adios_comm_totalpe,err)
- call adios2_put(engine, 'mype',adios_comm_mype,err)
- call adios2_put(engine, 'inum_arr',spall(1)%num,err)
- call adios2_put(engine, 'ioff_arr',ioff,err)
-
- if(sml_electron_on)then
- call adios2_put(engine, 'enum',spall(0)%num,err)
- call adios2_put(engine, 'enphase',ict2,err)
- call adios2_put(engine, 'emaxgid',spall(0)%maxgid,err)
- call adios2_put(engine, 'enum_total',enum_total,err)
- call adios2_put(engine, 'eoff',eoff,err)
- call adios2_put(engine, 'enum_arr',spall(0)%num,err)
- call adios2_put(engine, 'eoff_arr',eoff,err)
- endif
- !! jyc: fix for issue with InSituMPI
- call adios2_end_step(engine, err)
- call adios2_begin_step(engine, adios2_step_mode_append, 0.0, istatus, err)
-
- ! Number of Ions changes every step, so we need to modify the definition
- ! before writing
- call adios2_set_shape(vigid, 1, (/ inum_total /), err)
- call adios2_set_selection(vigid, 1, (/ ioff /), (/ inum*1_8 /), err)
- call adios2_put(engine, vigid, gid, err)
-
- call adios2_set_shape(viphase, 2, (/ ict2*1_8,inum_total /), err)
- call adios2_set_selection(viphase, 2, (/ 0_8,ioff /), (/ ict2*1_8,inum*1_8 /), err)
- call adios2_put(engine, viphase, phase, err)
-
- if(sml_electron_on)then
- ! Number of electrons changes every step, so we need to modify the definition
- ! before writing
- call adios2_set_shape(vegid, 1, (/ enum_total /), err)
- call adios2_set_selection(vegid, 1, (/ eoff /), (/ enum*1_8 /), err)
- call adios2_put(engine, vegid, egid, err)
-
- call adios2_set_shape(vephase, 2, (/ ict2*1_8,enum_total /), err)
- call adios2_set_selection(vephase, 2, (/ 0_8,eoff /), (/ ict2*1_8,enum*1_8 /), err)
- call adios2_put(engine, vephase, ephase, err)
- endif
-
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_WRITE_DCX_PARTICLE")
- if (sml_mype.eq.0) print *, 'DCX: Write particle end step:', sml_gstep
- if (.not.dcx_particle_stage) then
- call adios2_close(engine, err)
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.particle.",i1.1,".",i5.5,".bp.unlock")') dcx_side, sml_gstep
- open(20, file=filename, status="unknown", action="write")
- close(20)
- endif
- endif
- end subroutine dcx_write_particle
-
- subroutine dcx_read_particle(spall,grid,psn)
- use sml_module
- use ptl_module
- use f0_module
- use grid_class
- use psn_class
- use adios_read_mod
- use sheath_module, only: sheath_nphi, sheath_pot
- use adios2_comm_module
- implicit none
- type(grid_type):: grid
- type(psn_type):: psn
- type(species_type) :: spall(0:ptl_nsp_max)
- ! integer :: i,ierr,err
- ! character (len=50) :: filename,dirname
- ! integer*8 :: buf_id, buf_size, total_size
- ! integer :: istep_restart
- ! logical :: fexist
- integer :: np, np2
- real (8), allocatable :: phase(:,:)
- integer (8), allocatable :: gid(:)
- real (8), allocatable :: ephase(:,:)
- integer (8), allocatable :: egid(:)
- integer, parameter :: ict1=ptl_nphase+1
- integer, parameter :: ict2=ptl_nphase+ptl_nconst
- ! integer :: adios_read_method = ADIOS_READ_METHOD_BP
- ! integer*8 :: sel0=0, sel1=0, sel2=0, sel3=0, sel4=0
- ! integer*8 :: bb_start1(1), bb_count1(1), bb_start2(2), bb_count2(2)
- ! integer*8 :: bb_start3(3), bb_count3(3)
- ! integer*8 :: bb_start4(4), bb_count4(4)
-
- ! integer :: istep_f0_restart, vpdata, mudata, ndata, idum
- ! real (8) :: time_f0_restart
- ! integer :: nnode, ntor, isize
-
- integer :: inum, enum
- integer*8 :: ioff, eoff
- ! integer :: adios_comm, adios_comm_mype
- integer :: totalpe, nsplit, noff, nblock
-
- character(512) :: filename
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- integer :: err, istatus
- logical :: ex
-
- integer :: block_inum, block_enum
- integer*8 :: block_ioff, block_eoff
- integer, allocatable :: inum_arr(:), enum_arr(:)
-
- !! Wait lock
- if (.not.dcx_particle_stage) then
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.particle.",i1.1,".",i5.5,".bp.unlock")') dcx_other, sml_gstep
- ex=.false.
- do while(.not.ex)
- print *, 'Waiting: ', trim(filename)
- inquire(file=filename,EXIST=ex)
- call sleep(1)
- end do
- endif
- call mpi_barrier(sml_comm, err)
- endif
-
- !!read from xgc.particle.XXXXX.bp
- if (dcx_particle_stage) then
- write(filename,'("../coupling/xgc.dcx.particle.",i1.1,".bp")') dcx_other
- else
- write(filename,'("../coupling/xgc.dcx.particle.",i1.1,".",i5.5,".bp")') dcx_other, sml_gstep
- endif
-
- if (isfirst) then
- if (sml_mype.eq.0) print *, 'DCX: Reading particle from stream ', trim(filename)
- call adios2_declare_io(io, adios2obj, "dcx.read.particle", err)
- call adios2_open(engine, io, filename, adios2_mode_read, sml_comm, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- if (dcx_particle_stage) then
- call adios2_comm_engine_push(engine)
- endif
- isfirst=.false.
- else
- if (.not.dcx_particle_stage) then
- call adios2_remove_all_variables(io, err)
- call adios2_remove_all_attributes(io, err)
- call adios2_open(engine, io, filename, adios2_mode_read, sml_comm, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- endif
- endif
-
- if (sml_mype.eq.0) print *, "DCX: Read particle begin step: ", sml_gstep
- call t_startf("ADIOS_READ_DCX_PARTICLE")
- call adios2_begin_step(engine, adios2_step_mode_read, -1.0, istatus, err)
- if(err.ne.0) then
- print *, 'Failed to begin step:', err
- stop
- endif
- if(istatus.ne.adios2_step_status_ok) then
- print *, 'Status error in begin step:', istatus
- stop
- endif
-
- !! jyc: issue iwth InSituMPI; i) no scalar, ii) no multiple sync read
- !! jyc: changed to read from input
- !call adios2_get(engine, "totalpe", totalpe, err)
- !call adios2_perform_gets(engine, err)
- totalpe = dcx_read_totalpe
-
- !! nblock > 1 when reading multiple blocs
- !! nsplit > 1 when reading sub-blocks
- !! Cannot be both are > 1
- if (sml_plane_totalpe*sml_intpl_totalpe.ge.totalpe) then
- nblock = 1
- nsplit = sml_plane_totalpe*sml_intpl_totalpe/totalpe
- noff = mod(sml_mype, nsplit)
- if (mod(sml_plane_totalpe*sml_intpl_totalpe, totalpe).ne.0) then
- if (sml_mype==0) print *, 'Error: Total PE mismatch:', sml_plane_totalpe*sml_intpl_totalpe, totalpe
- stop
- endif
- else
- nblock = totalpe/(sml_plane_totalpe*sml_intpl_totalpe)
- nsplit = 1
- noff = 0
- if (mod(totalpe, sml_plane_totalpe*sml_intpl_totalpe).ne.0) then
- if (sml_mype==0) print *, 'Error: Total PE mismatch:', sml_plane_totalpe*sml_intpl_totalpe, totalpe
- stop
- endif
- endif
- allocate(inum_arr(nblock), enum_arr(nblock))
- if (sml_mype==0) print *, 'Restart reading ratio: ', nsplit, nblock
-
- call adios2_inquire_variable(var, io, 'inum_arr', err)
- call adios2_set_selection(var, 1, (/ sml_mype/nsplit*nblock*1_8 /), (/ nblock*1_8 /), err)
- call adios2_get(engine, var, inum_arr, err)
-
- call adios2_inquire_variable(var, io, 'ioff_arr', err)
- call adios2_set_selection(var, 1, (/ sml_mype/nsplit*1_8 /), (/ 1_8 /), err)
- call adios2_get(engine, var, block_ioff, err)
-
- ! electron
- if(sml_electron_on)then
- call adios2_inquire_variable(var, io, 'enum_arr', err)
- call adios2_set_selection(var, 1, (/ sml_mype/nsplit*nblock*1_8 /), (/ nblock*1_8 /), err)
- call adios2_get(engine, var, enum_arr, err)
-
- call adios2_inquire_variable(var, io, 'eoff_arr', err)
- call adios2_set_selection(var, 1, (/ sml_mype/nsplit*1_8 /), (/ 1_8 /), err)
- call adios2_get(engine, var, block_eoff, err)
- endif
- call adios2_perform_gets(engine, err)
-
- block_inum = sum(inum_arr)
- inum = block_inum/nsplit
- ioff = block_ioff + inum*noff
- if (noff.eq.(nsplit-1)) then
- inum = block_inum - inum*noff
- endif
- ! electron
- if(sml_electron_on)then
- block_enum = sum(enum_arr)
- enum = block_enum/nsplit
- eoff = block_eoff + enum*noff
- if (noff.eq.(nsplit-1)) then
- enum = block_enum - enum*noff
- endif
- endif
- deallocate(inum_arr, enum_arr)
- !print *, sml_mype, 'Particle Read(step,offset,ndata):', sml_gstep, ioff, inum, eoff, enum
-
- !! jyc: fix for issue with InSituMPI
- call adios2_end_step(engine, err)
- call adios2_begin_step(engine, adios2_step_mode_read, -1.0, istatus, err)
-
- !spall(1)%num = inum
- !np=spall(1)%num
- allocate(phase(ict2,inum),gid(inum))
-
- if (inum.gt.0) then
- call adios2_inquire_variable(var, io, 'igid', err)
- call adios2_set_selection(var, 1, (/ ioff /), (/ inum*1_8 /), err)
- call adios2_get(engine, var, gid, err)
-
- call adios2_inquire_variable(var, io, 'iphase', err)
- call adios2_set_selection(var, 2, (/ 0_8,ioff /), (/ ict2*1_8,inum*1_8 /), err)
- call adios2_get(engine, var, phase, err)
- endif
-
- ! electron
- if(sml_electron_on)then
- if (enum.gt.0) then
- allocate(ephase(ict2,enum), egid(enum))
-
- call adios2_inquire_variable(var, io, 'egid', err)
- call adios2_set_selection(var, 1, (/ eoff /), (/ enum*1_8 /), err)
- call adios2_get(engine, var, egid, err)
-
- call adios2_inquire_variable(var, io, 'ephase', err)
- call adios2_set_selection(var, 2, (/ 0_8,eoff /), (/ ict2*1_8,enum*1_8 /), err)
- call adios2_get(engine, var, ephase, err)
- endif
- endif
- call adios2_perform_gets(engine, err)
-
- deallocate(phase,gid)
- ! electron
- if(sml_electron_on)then
- deallocate(ephase,egid)
- endif
-
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_READ_DCX_PARTICLE")
- if (sml_mype.eq.0) print *, "DCX: Read particle end step: ", sml_gstep
-
- if (err.eq.adios2_step_status_end_of_stream) then
- if (sml_mype.eq.0) print *, " Stream has terminated. Quit reader"
- elseif (err.eq.adios2_step_status_not_ready) then
- if (sml_mype.eq.0) print *, " Next step has not arrived for a while. Assume termination"
- endif
-
- if (.not.dcx_particle_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Read close ', trim(filename)
- call adios2_close(engine, err)
- endif
-
- end subroutine dcx_read_particle
-
- subroutine dcx_write_ff(grid,psn)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module, only : ptl_isp, ptl_nsp
- use f0_module
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- !
- integer :: nnode, nphi, iphi
- character (len=256) :: filename
- integer :: err, istatus
- !
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- type(adios2_attribute) :: att
-
- !! Only plane-rank 0 process write
- if (sml_plane_mype.eq.0) then
- nnode=grid%nnode
- nphi=sml_nphi_total
- iphi=sml_intpl_mype
-
- if (dcx_ff_stage) then
- write(filename,'("../coupling/xgc.dcx.ff.",i1.1,".bp")') dcx_side
- else
- write(filename,'("../coupling/xgc.dcx.ff.",i1.1,".",i5.5,".bp")') dcx_side, sml_gstep
- endif
-
- if (isfirst) then
- isfirst=.false.
- ! Definition of variables
- if (sml_mype == 0) print *, 'DCX: write define variables for ff'
- call adios2_declare_io(io, adios2obj, 'dcx.write.ff', err)
- !!psn%pot_rho_ff [real(8)] (0:1,0:grid%nrho,grid%nnode)
- !!psn%E_rho_ff [real(8)] (3,0:1,0:grid%nrho,grid%nnode)
- call adios2_comm_define_variable(var, io, 'pot_rho_ff', psn%pot_rho_ff(:,:,:), &
- (/ 2_8, 1_8*grid%nrho+1_8, 1_8*nnode, 1_8*nphi /), &
- (/ 0_8, 0_8, 0_8, 1_8*iphi /), &
- (/ 2_8, 1_8*grid%nrho+1_8, 1_8*nnode, 1_8 /), &
- .false., err)
- call adios2_comm_define_variable(var, io, 'E_rho_ff', psn%E_rho_ff(:,:,:,:), &
- (/ 3_8, 2_8, 1_8*grid%nrho+1_8, 1_8*nnode, 1_8*nphi /), &
- (/ 0_8, 0_8, 0_8, 0_8, 1_8*iphi /), &
- (/ 3_8, 2_8, 1_8*grid%nrho+1_8, 1_8*nnode, 1_8 /), &
- .false., err)
-
- if (dcx_ff_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write ff to stream "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, sml_intpl_comm, err)
- call adios2_comm_engine_push(engine)
- endif
- endif
-
- if (.not.dcx_ff_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Write ff to file "', trim (filename), '"'
- ! Open adios2 file
- call adios2_open(engine, io, filename, adios2_mode_write, sml_intpl_comm, err)
- endif
- if (sml_mype.eq.0) print *, 'DCX: Write ff begin step:', sml_gstep
- call t_startf("ADIOS_WRITE_DCX_FF")
- call adios2_begin_step(engine, adios2_step_mode_append, 0.0, istatus, err)
- if(err.ne.adios2_step_status_ok) then
- print *, 'Failed to begin step:', err
- endif
-
- call adios2_put(engine, 'pot_rho_ff', psn%pot_rho_ff(:,:,:), err)
- call adios2_put(engine, 'E_rho_ff', psn%E_rho_ff(:,:,:,:), err)
-
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_WRITE_DCX_FF")
- if (sml_mype.eq.0) print *, 'DCX: Write ff end step:', sml_gstep
- if (.not.dcx_ff_stage) then
- call adios2_close(engine, err)
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.ff.",i1.1,".",i5.5,".bp.unlock")') dcx_side, sml_gstep
- open(20, file=filename, status="unknown", action="write")
- close(20)
- endif
- endif
- !print *, sml_mype, 'pot_rho_ff', sum(psn%pot_rho_ff), psn%pot_rho_ff(1,1,1), psn%pot_rho_ff(1,1,2)
- !print *, sml_mype, 'E_rho_ff', sum(psn%E_rho_ff), psn%E_rho_ff(1,1,1,1), psn%E_rho_ff(1,1,1,2)
- endif
- end subroutine dcx_write_ff
-
- subroutine dcx_read_ff(grid,psn)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module, only : ptl_isp, ptl_nsp
- use f0_module
- use adios2_comm_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- !
- integer :: nnode, nphi, iphi
- character (len=256) :: filename
- integer :: err, istatus
- !
- logical, save :: isfirst = .true.
- type(adios2_engine), save :: engine
- type(adios2_io), save :: io
- type(adios2_variable) :: var
- type(adios2_attribute) :: att
- logical :: ex
-
- nnode=grid%nnode
- nphi=sml_nphi_total
- iphi=sml_intpl_mype
-
- !! Only plane-rank 0 process read and broacast
- if (sml_plane_mype.eq.0) then
- !! Wait lock
- if (.not.dcx_ff_stage) then
- if (sml_mype.eq.0) then
- write(filename,'("../coupling/xgc.dcx.ff.",i1.1,".",i5.5,".bp.unlock")') dcx_other, sml_gstep
- ex=.false.
- do while(.not.ex)
- print *, 'Waiting: ', trim(filename)
- inquire(file=filename,EXIST=ex)
- call sleep(1)
- end do
- endif
- call mpi_barrier(sml_intpl_comm, err)
- endif
-
- if (dcx_ff_stage) then
- write(filename,'("../coupling/xgc.dcx.ff.",i1.1,".bp")') dcx_other
- else
- write(filename,'("../coupling/xgc.dcx.ff.",i1.1,".",i5.5,".bp")') dcx_other, sml_gstep
- endif
-
- if (isfirst) then
- isfirst=.false.
- if (sml_mype.eq.0) print *, 'DCX: Reading ff from stream ', trim(filename)
- call adios2_declare_io(io, adios2obj, "dcx.read.ff", err)
- call adios2_open(engine, io, filename, adios2_mode_read, sml_intpl_comm, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- if (dcx_ff_stage) then
- call adios2_comm_engine_push(engine)
- endif
- else
- if (.not.dcx_f0_stage) then
- call adios2_remove_all_variables(io, err)
- call adios2_remove_all_attributes(io, err)
- call adios2_open(engine, io, filename, adios2_mode_read, sml_intpl_comm, err)
- if(err.ne.0) then
- print *, 'Failed to open stream: ', trim(filename), err
- stop
- endif
- endif
- endif
-
- if (sml_mype.eq.0) print *, "DCX: Read ff begin step: ", sml_gstep
- call t_startf("ADIOS_READ_DCX_FF")
- call adios2_begin_step(engine, adios2_step_mode_read, -1.0, istatus, err)
- if(err.ne.0) then
- print *, 'Failed to begin step:', err
- stop
- endif
- if(istatus.ne.adios2_step_status_ok) then
- print *, 'Status error in begin step:', istatus
- stop
- endif
-
- call adios2_inquire_variable(var, io, 'pot_rho_ff', err)
- call adios2_set_selection(var, 4, &
- (/ 0_8, 0_8, 0_8, 1_8*iphi /), &
- (/ 2_8, 1_8*grid%nrho+1_8, 1_8*nnode, 1_8 /), err)
- call adios2_get(engine, var, psn%pot_rho_ff(:,:,:), err)
-
- call adios2_inquire_variable(var, io, 'E_rho_ff', err)
- call adios2_set_selection(var, 5, &
- (/ 0_8, 0_8, 0_8, 0_8, 1_8*iphi /), &
- (/ 3_8, 2_8, 1_8*grid%nrho+1_8, 1_8*nnode, 1_8 /), err)
- call adios2_get(engine, var, psn%E_rho_ff(:,:,:,:), err)
-
- if (sml_mype.eq.0) print *, "DCX: Read ff end step: ", sml_gstep
- call adios2_end_step(engine, err)
- call t_stopf("ADIOS_READ_DCX_FF")
- if (err.eq.adios2_step_status_end_of_stream) then
- if (sml_mype.eq.0) print *, " Stream has terminated. Quit reader"
- elseif (err.eq.adios2_step_status_not_ready) then
- if (sml_mype.eq.0) print *, " Next step has not arrived for a while. Assume termination"
- endif
-
- if (.not.dcx_ff_stage) then
- if (sml_mype.eq.0) print *, 'DCX: Read close ', trim(filename)
- call adios2_close(engine, err)
- endif
- endif
- call mpi_bcast(psn%pot_rho_ff,size(psn%pot_rho_ff),mpi_real8,0,sml_plane_comm,err)
- call mpi_bcast(psn%E_rho_ff,size(psn%E_rho_ff),mpi_real8,0,sml_plane_comm,err)
- !print *, sml_mype, 'pot_rho_ff', sum(psn%pot_rho_ff), psn%pot_rho_ff(1,1,1), psn%pot_rho_ff(1,1,2)
- !print *, sml_mype, 'E_rho_ff', sum(psn%E_rho_ff), psn%E_rho_ff(1,1,1,1), psn%E_rho_ff(1,1,1,2)
- end subroutine dcx_read_ff
-
-end module dcx_coupling_module
diff --git a/XGC_core/diag_main_loop.F90 b/XGC_core/diag_main_loop.F90
deleted file mode 100644
index 4bc5ddb2..00000000
--- a/XGC_core/diag_main_loop.F90
+++ /dev/null
@@ -1,240 +0,0 @@
-module diag_main_loop_module
-!perhaps combine with diag_module?
-
-contains
-
-
-subroutine diag_main_loop(grid,psn,shift_opt,e_shift_opt)
- use sml_module
- use diag_module
- use grid_class
- use psn_class
- use ptl_module
- use f0_module
- use omp_module , only : split_indices
- use push_module, only : push
- use pol_decomp_module, only : f0_inode1,f0_inode2,f0_inode1_save,f0_inode2_save
- use load_balance_module, only : load_balance, update_poloidal_decomposition,update_load_balance_cost_tracking
- use shift_module, only : shift_sp
- use perf_monitor
- use main_extra, only : mon_start, mon_stop
- use dcx_coupling_module
- implicit none
- type(grid_type) :: grid
- type(psn_type) :: psn
- integer :: it, ith, i, istep, ipc, isp
- integer :: ncycle
- type(species_type) :: spfullf(0:ptl_nsp_max) !ions only
- real (kind=8) :: phase0(ptl_nphase,diag_fullf_turb_ptl_num)
- integer :: i_beg(sml_nthreads), i_end(sml_nthreads)
- integer :: err
- integer, optional :: shift_opt(num_shift_ie_opts), e_shift_opt(num_shift_ie_opts)
- character (len=1024) :: file_suffix
- logical, save :: marker_created = .false.
- integer :: final_istep
- logical :: diag_on
-
- final_istep = sml_mstep+1
-
- !TODO: Don't hardcode diag_fullf_in/outpsi, add to setup
- !TODO: Change from core
- diag_fullf_inpsi=0.92*eq_x_psi !0.2
- diag_fullf_outpsi=1.03*eq_x_psi !0.3
-
-
- ipc=2 !fix, for doing the full push step (dont need partial to get fields)
- !analysis main loop
- do istep=1,sml_mstep
- !@effis-timestep physical=istep*sml_dt, number=istep
- call mon_start(MAIN_LOOP_)
- call t_startf("MAIN_LOOP")
- call t_adj_detailf(+1)
-
- sml_istep=istep
- sml_gstep=sml_gstep+1
-
- if (istep > diag_fullf_turb_start) then
-
- !!!!!!!!!!!!CREATE FULL-F MARKERS on diag_fullf_turb_period steps!!!!!!!!!!!!!!!!!!!!
- !if (sml_mype.eq.0) print *, sml_mype, 'sml_gstep,diag_fullf_turb_period', sml_gstep,diag_fullf_turb_period
- if (mod(sml_gstep+dcx_step_offset,diag_fullf_turb_period).eq.0) then
- !TODO Set real dcx call. Make sure set to f0_f.
- if ((mod(sml_gstep+dcx_step_offset,dcx_read_f0_period).eq.0)) then
- if (sml_mype.eq.0) print *, sml_mype, 'DCX coupling wait f0', dcx_side, sml_gstep
- call t_startf("DCX_COUPLING_WAIT")
- call mpi_barrier(MPI_COMM_WORLD, err);
- call t_stopf("DCX_COUPLING_WAIT")
- call t_startf("DCX_READ_F0")
- call dcx_read_f0(grid,psn)
- call t_stopf("DCX_READ_F0")
- endif
-
- !TODO This is a hack so serial diag_fullf_turb will still work (v_and_weight uses
- ! these _save vars directly). Needed in serial version, since these can change
- ! normally with updated decomposition, and we don't use until diag_fullf_turb_period
- ! passes. But here in coupling/staging, we are using in the same time step
- f0_f_save = f0_f
- f0_inode1_save=f0_inode1
- f0_inode2_save=f0_inode2
- f0_T_ev_save=f0_T_ev
- f0_B_B0_save=f0_B_B0
-
- !TODO: BIG IMPROVEMENT IF ALL RANKS CAN PUSH PARTICLES (currently only those who
- ! f0_indoe1/2 covered by diag_fullf_in/outpsi). MAY NEED TO WORK OUT
- ! SEPARATE SHIFT_SP LOGIC
- !jyc: how to handle already created markers
- !jyc: temporary fix: only create once
- if (.not.marker_created) call create_fullf_markers(grid,psn,spfullf)
- if (spfullf(1)%num>0) print *,'Finished diag_fullf_turb particle creation ',sml_mype
- marker_created=.true.
- !print *, sml_mype, 'spfullf(1)%num', spfullf(1)%num
-
- if (spfullf(1)%num>0) print *,'Start shift_opt storage ',sml_mype
- !hack to get shift_opts
- spfullf(1)%shift_opt(:) = shift_opt(:)
- if (sml_electron_on) then
- spfullf(0)%shift_opt(:) = e_shift_opt(:)
- endif
-
- call t_startf("DIAG_FULLF_TURB_SHIFT")
- if (spfullf(1)%num>0) print *,'Start shift_sp ',sml_mype
- !I think I need this initially, but not sure
- call shift_sp(grid,psn,spfullf(1))
- !to update non sp%ptl (e.g. sp%tr_save)
- call chargei_search_index(grid,psn,spfullf(1)) ! sub-subroutine
- if (sml_electron_on) then
- call shift_sp(grid,psn,spfullf(0))
- !to update non sp%ptl (e.g. sp%tr_save)
- call chargee_search_index(grid,psn,spfullf(0)) ! sub-subroutine
- endif
- call t_stopf("DIAG_FULLF_TURB_SHIFT")
-
- call t_startf("DIAG_FULLF_TURB_DIAG_PARTICLE")
- call diag_particle2(grid,psn,spfullf,sml_gstep,"diag0")
- call t_stopf("DIAG_FULLF_TURB_DIAG_PARTICLE")
-
- !reset tr_init and dr
- call diag_fullf_reset(spfullf(1))
- if (sml_electron_on) then
- call diag_fullf_reset(spfullf(0))
- endif
- endif
-
- if (.not.marker_created) cycle
-
- ! load balancing part ---------------------------------------------
- call t_startf("DIAG_FULLF_TURB_LOADB")
- if (sml_debug_flag) call check_point('load balance')
- call load_balance(spfullf)
- call update_poloidal_decomposition(grid,psn,spfullf)
- call t_stopf("DIAG_FULLF_TURB_LOADB")
-
-
- !!!!!!!!!!!populate phase0, since won't populate in ipc=1 call
- do isp=ptl_isp,ptl_nsp
- call split_indices(spfullf(isp)%num, sml_nthreads, i_beg, i_end)
- !$OMP PARALLEL DO &
- !$OMP PRIVATE( ITH, I )
- do ith=1,sml_nthreads
- do i=i_beg(ith), i_end(ith)
- spfullf(isp)%phase0(:,i)=spfullf(isp)%ptl(i)%ph
- enddo
- enddo
- enddo
-
-
- !!!!!!!!!GET DATA FROM MAIN XGC !!!!!!!!!!!!!!!!!!!!!!!!!!!
- !TODO Set real dcx call. Make sure set to f0_f.
- if ((mod(sml_gstep+dcx_step_offset,dcx_read_ff_period).eq.0)) then
- if (sml_mype.eq.0) print *, sml_mype, 'DCX coupling wait ff', dcx_side, sml_gstep
- call t_startf("DCX_COUPLING_WAIT")
- call mpi_barrier(MPI_COMM_WORLD, err);
- call t_stopf("DCX_COUPLING_WAIT")
- call t_startf("DCX_READ_FF")
- call dcx_read_ff(grid,psn)
- call t_stopf("DCX_READ_FF")
- endif
- !TODO We need to pass shpot also I believe. But only when we do electrons probably.
- !call dcx_read_shpot()
-
- !!!!!!!!!!!! PARTILE PUSH !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- call t_startf("DIAG_FULLF_TURB_PUSH")
- !if (spfullf(1)%num>0) print *,'pushing ',it,sml_mype
- if(sml_electron_on) then
- !RMC 2020/07/10 - Pretty sure we dont need this, since ipc==2 for diag_main_loop
- !call save_or_load_electron_phase(spall(0),ipc) ! Also f0 is restored.
- ncycle=sml_ncycle_half*2 !always ipc=2
-
-
-!RMC 2020/07/10 - Do I need this? Dont think so, but not sure, if we already get E-field sent from XGC1 main
-! #ifdef XGC1
-! !##################################################################
-! !electron push with sub-cycling
-! call t_startf("GAT_FIELD_INFO")
-! call gather_field_info(grid,psn) ! gather other plane E-field info
-! call t_stopf("GAT_FIELD_INFO")
-! ! gather_field_info should be block here
-! !#################################################################
-! #endif
-
- diag_on=.false.
- write (file_suffix, "(A16,I0.3)") "diag_preelectron.",mod(sml_gstep,diag_fullf_turb_period)-1
- call diag_particle2(grid,psn,spfullf,sml_gstep,file_suffix)
- call pushe(istep,ncycle,grid,psn,spfullf(0),diag_on)
- ! Perform electron collisions on electron sub-cycling time-step.
- ! FOR COLLLISIONS: call collision(istep, spfullf(0)) ! electron collisions
- write (file_suffix, "(A17,I0.3)") "diag_postelectron.",mod(sml_gstep,diag_fullf_turb_period)-1
- call diag_particle2(grid,psn,spfullf,sml_gstep,file_suffix)
- endif
- call push(istep,ipc,grid,psn,spfullf(1),spfullf(1)%phase0,spfullf(1)%ptl,.false.)
- call t_stopf("DIAG_FULLF_TURB_PUSH")
-
- ! Perform collisions after the push. If we print out flow or current diagnostic
- ! we need to take care where we perform collisions. If no flow or current diagnostics
- ! we can perform it anywhere we want, but after the push is a good place.
-
- ! FOR COLLISIONS: call collision(istep, spfullf(1)) ! perform ion collisions.
-
- call t_startf("DIAG_FULLF_TURB_SHIFT")
- ! Shifts particle who wandered outside the spatial domain they were assigned to
- ! to the right MPI ranks.
- call shift_sp(grid,psn,spfullf(1))
- call chargei_search_index(grid,psn,spfullf(1)) ! sub-subroutine
- if (sml_electron_on) then
- call shift_sp(grid,psn,spfullf(0))
- call chargee_search_index(grid,psn,spfullf(0)) ! sub-subroutine
- endif
- call t_stopf("DIAG_FULLF_TURB_SHIFT")
-
- !!!!!!!!!!! save data !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !print *,'it,ptl_num,sml_mype',it,spfullf(1)%num,sml_mype
- call t_startf("DIAG_FULLF_TURB_DIAG_PARTICLE")
- write (file_suffix, "(A5,I0.3)") "diag1.",mod(sml_gstep,diag_fullf_turb_period)-1
- call diag_particle2(grid,psn,spfullf,sml_gstep,file_suffix)
- call t_stopf("DIAG_FULLF_TURB_DIAG_PARTICLE")
-
- endif !end istep
-
- call t_adj_detailf(-1)
- call t_stopf("MAIN_LOOP")
- call mon_stop(MAIN_LOOP_,final_istep)
-#ifndef NO_FLUSH
- call flush(6)
-#endif
- if (sml_debug_flag) call check_point('after mon_stop main loop')
-
- ! Timer information
- if (mon_flush_freq > 0) then
- if (mod(istep,mon_flush_freq) .eq. 0) &
- call flush_perf_monitor(istep)
- endif
-
- if (sml_debug_flag) call check_point('end of main loop')
- enddo
- !if (spfullf(1)%num>0) print *,'Finish diag_fullf_turb particle push ',sml_mype
-
-
-end subroutine diag_main_loop
-
-
-end module
diff --git a/XGC_core/efield.F90 b/XGC_core/efield.F90
index 587e2ed9..1ad397a8 100644
--- a/XGC_core/efield.F90
+++ b/XGC_core/efield.F90
@@ -97,10 +97,6 @@ subroutine efield_gk(grid,psn,sp,i,fld,itr,p) !requires fld%(r,z,phi,br,bz,bphi)
!get E
ptl_active=merge(1D0,0D0,itr .gt. 0)
itr_work = nint(ptl_active)*itr + (1-nint(ptl_active))*1
- if (itr_work<1.or.itr_work>grid%ntriangle) then
- print *, sml_mype, 'Skip itr_work', itr_work
- goto 79
- endif
do ip=1, 3
node = nint(ptl_active)*grid%nd(ip,itr_work) + (1-nint(ptl_active))*1
wp = ptl_active*p(ip)
@@ -116,11 +112,6 @@ subroutine efield_gk(grid,psn,sp,i,fld,itr,p) !requires fld%(r,z,phi,br,bz,bphi)
!find rho index
rhon=min(rho,grid%rhomax)/grid%drho
irho=min(floor(rhon),grid%nrho-1)
- !jyc temporary fix
- if (irho.lt.0) then
- print *, sml_mype, 'Skip irho,rho:', irho, rho
- goto 99
- endif
wrho(2)=rhon - real(irho)
wrho(1)=1D0-wrho(2)
@@ -212,9 +203,7 @@ subroutine efield_gk(grid,psn,sp,i,fld,itr,p) !requires fld%(r,z,phi,br,bz,bphi)
#endif
!---> NEWGYROMATRIX
#endif
-99 continue
enddo
-79 continue
#if defined(XGCA) || defined(NEOCLASSICAL_TEST)
!if (induction_fac==0D0) then E(3)=0D0
diff --git a/XGC_core/load.F90 b/XGC_core/load.F90
index bff969af..8c338deb 100644
--- a/XGC_core/load.F90
+++ b/XGC_core/load.F90
@@ -102,7 +102,7 @@ subroutine load(grid,psn,spall)
! First, set particle position (r,z,phi) uniformly in simulation region
- call uniform_space_dist(grid,psn,spall, 0, sml_inpsi, sml_outpsi)
+ call uniform_space_dist(grid,psn,spall)
! if(.not. sml_deltaf .and. sml_electron_on .and. spall(1)%num==spall(0)%num) then
! !debug
! spall(0)%phase(1:3,1:spall(1)%num) = spall(1)%phase(1:3,1:spall(1)%num)
@@ -694,7 +694,7 @@ end subroutine maxwell_v_dist
!! Distribute particle uniformly in space. (inpsi < psi < outpsi)
!!> The r,z,phi,psi of phase variable are set
!!<
-subroutine uniform_space_dist(grid,psn,spall,tindex,inpsi,outpsi)
+subroutine uniform_space_dist(grid,psn,spall)
use grid_class
use psn_class
use ptl_module
@@ -712,8 +712,6 @@ subroutine uniform_space_dist(grid,psn,spall,tindex,inpsi,outpsi)
type(grid_type), intent(in) :: grid
type(psn_type) :: psn
type(species_type) :: spall(0:ptl_nsp_max)
- integer, intent(in) :: tindex
- real (kind=8) :: inpsi, outpsi
integer :: isp
integer :: valid, ierr !! number of particle that generated inside the region inpsi<psi<outpsi
integer (8) :: total !! number of total particle generated
@@ -727,7 +725,6 @@ subroutine uniform_space_dist(grid,psn,spall,tindex,inpsi,outpsi)
real (kind=8) :: marker_den(grid%ntriangle,ptl_isp:ptl_nsp)
integer (8) :: buf_id, buf_size, total_size
integer :: err, isize
- character (len=256) :: filename
#ifdef ADIOS2
type(adios2_engine) :: engine
type(adios2_io) :: io
@@ -751,7 +748,6 @@ subroutine uniform_space_dist(grid,psn,spall,tindex,inpsi,outpsi)
! generate particle until # of valid particles become ptl_num
do while(valid<spall(isp)%num)
- !if (sml_mype==0) print *,valid,valid2
!generate r,z in simulation region
if (sml_cylindrical) then
! Cylindrical limit with periodic boundary conditions
@@ -770,7 +766,11 @@ subroutine uniform_space_dist(grid,psn,spall,tindex,inpsi,outpsi)
if(phi<0D0) phi=0D0 ! just for in case
!check psi validity
- if(inpsi < psi .AND. psi < outpsi) then
+!#ifdef XGC_COUPLING_CORE_EDGE
+! if(cce_inpsi < psi .AND. psi < sml_outpsi) then
+!#else
+ if(sml_inpsi < psi .AND. psi < sml_outpsi) then
+!#endif
! For the correct normalization, we need to count valid2 here --->
valid2=valid2+1D0
@@ -806,8 +806,6 @@ subroutine uniform_space_dist(grid,psn,spall,tindex,inpsi,outpsi)
! print*,maxval(marker_den)
!#endif
-if (sml_mype==0) print *,' Finished uniform_ marker creation'
-
isize=grid%ntriangle*(ptl_nsp-ptl_isp+1)
call mpi_allreduce(marker_den,sml_marker_den2,isize,MPI_REAL8,MPI_SUM,sml_comm,ierr)
do isp=ptl_isp,ptl_nsp
@@ -845,8 +843,7 @@ if (sml_mype==0) print *,' Finished uniform_ marker creation'
! Print out initial marker particle density
isize=(ptl_nsp-ptl_isp+1)
buf_size = 1000 + 2*4 + grid%ntriangle*8*isize
- write(filename,'("xgc.loading.",i5.5,".bp")') tindex
- ADIOS_OPEN(buf_id,'diagnosis.loading',filename,'w',sml_comm_null,err)
+ ADIOS_OPEN(buf_id,'diagnosis.loading','xgc.loading.bp','w',sml_comm_null,err)
ADIOS_GROUP_SIZE(buf_id,buf_size,total_size,err)
ADIOS_WRITE_LBL(buf_id,'ntriangle',grid%ntriangle,err)
ADIOS_WRITE_LBL(buf_id,'nsp',isize,err)
@@ -1665,9 +1662,6 @@ subroutine limit_marker_den(grid,psn,spall)
logical :: off_grid_only
logical, allocatable :: rgn12(:)
logical, parameter :: debug=.false.
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
allocate(wsum(f0_inode1:f0_inode2,sml_nthreads))
allocate(wsum2(f0_inode1:f0_inode2,sml_nthreads))
@@ -1799,7 +1793,6 @@ subroutine limit_marker_den(grid,psn,spall)
! to be counted towards the particle loss used in
! the neutral routine
call remove_particle(spall(isp),i,-3,ith)
- n_removed_particles = n_removed_particles + 1
removed(pnode(i),ith) = removed(pnode(i),ith) + 1D0
cycle
endif
@@ -1863,9 +1856,5 @@ subroutine limit_marker_den(grid,psn,spall)
200 format(a36,i8,2x,e9.2)
300 format(a28,3(i10,2x))
- if (n_removed_particles .gt. 0) then
- print *, "subroutine limit_marker_den: n_removed_particles = ", n_removed_particles
- endif
-
end subroutine limit_marker_den
diff --git a/XGC_core/load_balance_mod.F90 b/XGC_core/load_balance_mod.F90
index e4ca7d51..29f142fb 100644
--- a/XGC_core/load_balance_mod.F90
+++ b/XGC_core/load_balance_mod.F90
@@ -42,9 +42,6 @@ module load_balance_module
local_cost(3)=f0_cost
local_cost(2)=cumul_cost
local_cost(1)=real(spall(1)%num,8)
- if(sml_mype==0) write(6,1109) local_cost(0), local_cost(1), local_cost(2), local_cost(3)
-1109 format('local_cost ',F10.4,1x,F10.4,1x,F10.4,1x,F10.4)
-
if(sml_electron_on) then
local_cost(0)=real(spall(0)%num,8)
call mpi_allreduce(local_cost(0),total_cost(0),4,mpi_real8,mpi_sum,sml_comm,ierr)
@@ -175,8 +172,6 @@ module load_balance_module
call t_startf("SHIFT_I_R")
call t_set_prefixf("sir:")
call shift_sp(grid,psn,spall(1))
- !to update non sp%ptl (e.g. sp%tr_save)
- call chargei_search_index(grid,psn,spall(1)) ! sub-subroutine
call t_unset_prefixf()
call t_stopf("SHIFT_I_R")
@@ -184,8 +179,6 @@ module load_balance_module
call t_startf("SHIFT_E_R")
call t_set_prefixf("ser:")
call shift_sp(grid,psn,spall(0))
- !to update non sp%ptl (e.g. sp%tr_save)
- call chargee_search_index(grid,psn,spall(0))
call t_unset_prefixf()
call t_stopf("SHIFT_E_R")
endif
diff --git a/XGC_core/logical_sheath.F90 b/XGC_core/logical_sheath.F90
index de776324..ec093bec 100644
--- a/XGC_core/logical_sheath.F90
+++ b/XGC_core/logical_sheath.F90
@@ -383,9 +383,6 @@ contains
real (kind=8) :: new_phase(ptl_nphase)
integer :: widx
real (8) :: w1_change, en_perp, en_para_max
- ! debugging
- integer :: n_removed_particles
- n_removed_particles = 0
! find nearest wall point
@@ -418,7 +415,6 @@ contains
! if old position is also outside of grid --> remove particle and return
if(itr<0) then
call remove_particle(sp,iptl,-1,ith)
- n_removed_particles = n_removed_particles + 1
itrout=itr
pout=p
return
@@ -526,10 +522,6 @@ contains
pout=psave
endif
- if (n_removed_particles .gt. 0) then
- print *, "subroutine sheath_calculation_mode2: num_removed_particles = ", n_removed_particles
- endif
-
return
end subroutine sheath_calculation_mode2
@@ -1068,9 +1060,6 @@ contains
real (kind=8) :: new_phase(ptl_nphase)
integer :: widx
real (8) :: w1_change, en_perp
- ! debugging
- integer :: num_removed_particles
- num_removed_particles = 0
! find nearest wall point
new_phase=sp%phase0(:,iptl)
@@ -1102,7 +1091,6 @@ contains
! if old position is also outside of grid --> remove particle and return
if(itr<0) then
call remove_particle(sp,iptl,-1,ith)
- num_removed_particles = num_removed_particles + 1
itrout=itr
pout=p
return
@@ -1174,7 +1162,6 @@ contains
if (sml_ipc==2 .and. ((sp%type==1 .and. .not. sml_deltaf) &
.or. (sp%type==0 .and. .not. sml_deltaf_elec))) then
call remove_particle(sp,iptl,-1,ith)
- num_removed_particles = num_removed_particles + 1
endif
! for neutral:
! for ion electron simulations .and. .not. sml_neutral_use_ion_loss --> count electrons only
@@ -1224,10 +1211,6 @@ contains
pout=psave
endif
- if (num_removed_particles .gt. 0) then
- print *, "subroutine sheath_calculation_mode1: num_removed_particles = ", num_removed_particles
- endif
-
end subroutine sheath_calculation_mode1
diff --git a/XGC_core/main_loop.F90 b/XGC_core/main_loop.F90
index eed78261..e7da1027 100644
--- a/XGC_core/main_loop.F90
+++ b/XGC_core/main_loop.F90
@@ -10,7 +10,7 @@ subroutine main_loop(grid,psn,spall)
#ifndef USE_CAB_CPP
! No need to compile this if using the C++ version
#ifdef XGC1
- use diag_module, only : diag_3d_more, diag_fullf_turb_start
+ use diag_module, only : diag_3d_more
#else
use diag_module, only : diag_2d_more, diag_f2d_period
use coupling_module, only : coupling_turb_read
@@ -34,7 +34,6 @@ subroutine main_loop(grid,psn,spall)
use push_module, only : push
use restart_module, only : restart_write
use main_extra, only : mon_start, mon_stop
- use dcx_coupling_module
implicit none
integer :: ierr_mpi
diff --git a/XGC_core/main_loop_f90_routines.F90 b/XGC_core/main_loop_f90_routines.F90
index 5d5729fb..c94b5ea6 100644
--- a/XGC_core/main_loop_f90_routines.F90
+++ b/XGC_core/main_loop_f90_routines.F90
@@ -541,7 +541,6 @@ contains
use shift_module, only : shift_sp
use restart_module, only : restart_write
use main_extra, only : mon_start, mon_stop
- use dcx_coupling_module
implicit none
type(c_ptr) :: grid_cptr, psn_cptr, spall_cptr
type(grid_type), pointer :: grid
@@ -583,32 +582,6 @@ contains
endif
#endif
-#ifdef XGC1
- !! DCX coupling
- if (dcx_side.eq.0) then
- if ((mod(sml_gstep,dcx_write_particle_period).eq.0)) then
- call t_startf("DCX_WRITE_RESTART")
- call dcx_write_particle(spall,grid, psn)
- call t_stopf("DCX_WRITE_RESTART")
- endif
- if ((mod(sml_gstep,dcx_read_particle_period).eq.0)) then
- call t_startf("DCX_READ_RESTART")
- call dcx_read_particle(spall,grid, psn)
- call t_stopf("DCX_READ_RESTART")
- endif
- else
- if ((mod(sml_gstep,dcx_read_particle_period).eq.0)) then
- call t_startf("DCX_READ_RESTART")
- call dcx_read_particle(spall,grid, psn)
- call t_stopf("DCX_READ_RESTART")
- endif
- if ((mod(sml_gstep,dcx_write_particle_period).eq.0)) then
- call t_startf("DCX_WRITE_RESTART")
- call dcx_write_particle(spall,grid, psn)
- call t_stopf("DCX_WRITE_RESTART")
- endif
- endif
-#endif
end subroutine
subroutine coupling_turb_read_cpp_interface(grid_cptr,psn_cptr,istep) &
diff --git a/XGC_core/module.F90 b/XGC_core/module.F90
index d0f8e53a..866d202c 100644
--- a/XGC_core/module.F90
+++ b/XGC_core/module.F90
@@ -945,11 +945,7 @@ end module eq_module
!! Particle module
module ptl_module
-#ifdef DIAG_FULLF
- integer, parameter :: ptl_nphase=8, ptl_nconst=3, ptl_nphase2=12
-#else
integer, parameter :: ptl_nphase=6, ptl_nconst=3, ptl_nphase2=12
-#endif
integer, parameter :: ptl_nsp_max=1 ! 1 for single ion species
integer :: ptl_isp, ptl_nsp
@@ -1053,8 +1049,6 @@ module ptl_module
integer, parameter :: pir=1, piz=2, pip=3, pirho=4, pim=1, piw1=5, piw2=6, piw0=2, pif0=3
- !this is for DIAG_FULLF, leave defined for ease of compilation
- integer, parameter :: pidr=7, pitrinit=8
contains
subroutine ptl_mem_allocation( sp, sp_type, maxnum,mass, charge, nlarmor, lost_nummax)
implicit none
@@ -1094,8 +1088,6 @@ module ptl_module
#endif
else ! for electron
sp%type=0
- !! (2020/07) jyc: temporary fix
- allocate(sp%rhoi(maxnum))
#ifndef USE_CAB
! for subcycling
if (.not. allocated(ptl_ephase_save)) allocate(ptl_ephase_save(maxnum))
@@ -1896,14 +1888,6 @@ module diag_module
type(poin_type) :: diag_poin
- !full-f turbulence diagnostic
- integer :: diag_fullf_turb_period !< How often to run the diag_fullf_turb diagnostic
- integer :: diag_fullf_turb_start !< Time step index to start diag_fullf_turb diagnostic
- integer :: diag_fullf_turb_ptl_num !< # full-f diagnostic particles per process
- real (kind=8) :: diag_fullf_inpsi, diag_fullf_outpsi !< psi bounds for the full-f diagnostic particles
- real(kind=8), allocatable, dimension(:) :: diag_fullf_psi_save !< psi of the start values for full-f tracer pushe diagnostic
- real(kind=8), allocatable, dimension(:) :: diag_fullf_gid_save !< psi of the start values for full-f tracer pushe diagnostic
-
end module diag_module
!****************************************************************************
diff --git a/XGC_core/module_psn.F90 b/XGC_core/module_psn.F90
index 112be268..65dfc0cb 100644
--- a/XGC_core/module_psn.F90
+++ b/XGC_core/module_psn.F90
@@ -190,10 +190,6 @@ module psn_class
real (8), allocatable :: pot_phi_ff(:,:,:) !< Electrostatic potential for all planes in field-following format
real (8), allocatable :: E_phi_ff(:,:,:,:) !< Electric field for all planes in field-following format
real (8), allocatable :: ddpotdt_phi(:,:,:) !< Time derivative of phi-<phi> for all planes
-
- !TODO: Decide if to put in diag_fullf_turb module -RMC
- real (8), allocatable :: pot_rho_ff_save(:,:,:,:) !< phi-<phi> components of the electrostatic potential, field-following
- real (8), allocatable :: E_rho_ff_save(:,:,:,:,:) !< Gyro-averaged electric field in field-aligned format, (dir,i_plane,i_rho,i_node)
#ifndef F0_TOR_LINEAR
! Nearest neighbor interpolation along B
real (8), allocatable :: iden_rho_f0(:,:) !< Ion density contribution from the velocity grid
@@ -349,7 +345,6 @@ contains
!! @param[in] nhybrid Number of hybrid iterations in the calculation of the non-adiabatic elec. response, (integer)
subroutine psn_mem_alloc(psn,n,ntr,npsi,nrho,nhybrid)
use sml_module
- use diag_module, only : diag_fullf_turb_period
implicit none
!
type(psn_type), intent(inout) :: psn
@@ -397,14 +392,6 @@ contains
allocate( psn%E_phi_ff(0:1,3,n,0:nphim1) )
psn%E_phi_ff = 0D0
- !TODO: Decide whether to put into diag_fullf_turb module
- if (diag_fullf_turb_period>0) then
- allocate( psn%pot_rho_ff_save(diag_fullf_turb_period,0:1,0:nrho,n) )
- psn%pot_rho_ff = 0D0
- allocate( psn%E_rho_ff_save(diag_fullf_turb_period,3,0:1,0:nrho,n) )
- psn%E_rho_ff = 0D0
- endif
-
#ifndef F0_TOR_LINEAR
allocate( psn%iden_rho_f0(n,0:nrho) )
psn%iden_rho_f0 = 0D0
diff --git a/XGC_core/my_mpi.F90 b/XGC_core/my_mpi.F90
index d62d28c6..f7b452e7 100644
--- a/XGC_core/my_mpi.F90
+++ b/XGC_core/my_mpi.F90
@@ -41,15 +41,6 @@ subroutine MY_MPI_INIT(color)
if(present(color)) icolor = color
sml_comm_color = icolor
- !! override if color.in exists
- inquire(file='color.in',EXIST=exist)
- if (exist) then
- open(unit=14,file='color.in',status='old')
- read(14,*) icolor
- close(14)
- sml_comm_color = icolor
- endif
-
call mpi_init(ierror)
call mpi_comm_rank(MPI_COMM_WORLD,world_rank,ierror)
diff --git a/XGC_core/neutral_totalf.F90 b/XGC_core/neutral_totalf.F90
index 07f97847..d0143954 100644
--- a/XGC_core/neutral_totalf.F90
+++ b/XGC_core/neutral_totalf.F90
@@ -954,7 +954,7 @@ subroutine neutral_totalf_step(grid,mass)
type(grid_type) :: grid
real (kind=8), intent(in) :: mass
real (kind=8) :: rstart,zstart,r,z,vr,vz,vangle,tn,v,vparan,vparai
- integer :: i,ip,k,ipart,ptest,istep, ith,itr,j
+ integer :: i,ip,k,ipart,ptest,istep, ith,itr
real (kind=8) :: f_ion, f_cx, f_el,rate_ion,rate_cx,rate_el,drate
real (kind=8) :: denpe,denpi,teev,tiev,enev,xmax,sigma0,tekev
real (kind=8) :: weight, den, del,theta
@@ -987,9 +987,8 @@ subroutine neutral_totalf_step(grid,mass)
neu_norm_baseden(:) = 1D0
else
do k=1,neu_nbirth
- j = grid%wall_nodes_to_ordered(k)
- if(wsum(j)<(0.020*maxd)) wsum(j)=0.02D0*maxd
- sum_baseden = sum_baseden + wsum(j)*grid%wall_length(k)
+ if(wsum(k)<(0.020*maxd)) wsum(k)=0.02D0*maxd
+ sum_baseden = sum_baseden + wsum(grid%wall_nodes_to_ordered(k))*grid%wall_length(k)
sum_wall_length = sum_wall_length + grid%wall_length(k)
enddo
avg_baseden = max(1D0,sum_baseden/sum_wall_length)
diff --git a/XGC_core/pol_decomp.F90 b/XGC_core/pol_decomp.F90
index 99625933..75173808 100644
--- a/XGC_core/pol_decomp.F90
+++ b/XGC_core/pol_decomp.F90
@@ -18,7 +18,6 @@ module pol_decomp_module
! variables needed for load balancing; f0 variables declared here to avoid
! circular dependence with f0_module
integer :: f0_inode1, f0_inode2
- integer :: f0_inode1_save, f0_inode2_save
real (8) :: f0_ratio
real (8), allocatable :: f0_node_cost(:)
real (8) :: f0_grid_ptl_imbal
diff --git a/XGC_core/push.F90 b/XGC_core/push.F90
index 3fddef99..407f4776 100644
--- a/XGC_core/push.F90
+++ b/XGC_core/push.F90
@@ -31,9 +31,6 @@ subroutine push(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,dt_ext)
integer :: ith, i_beg(sml_nthreads), i_end(sml_nthreads)
real (kind=8) , external :: psi_interpol
character (len=5) :: err_str(2)
- ! debugging
- integer :: num_removed_particles
- num_removed_particles = 0
err_str(1)='ion'
err_str(2)='elec'
@@ -111,7 +108,6 @@ subroutine push(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,dt_ext)
!$OMP PARALLEL DO &
- !$OMP SHARED ( num_removed_particles ), &
!$OMP PRIVATE( ITH, I, NEW_PHASE, &
!$OMP OLD_PHASE, RTN )
do ith=1, sml_nthreads
@@ -127,11 +123,8 @@ subroutine push(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,dt_ext)
! check r-z boundary validity and update psi variables
if(new_phase(1)<eq_min_r .or. new_phase(1)>eq_max_r .or. new_phase(2)<eq_min_z .or. new_phase(2)>eq_max_z)then
-
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
- !print *,'blah'
- !print *, 'particle eliminated due to rz_outside in push:', i, sml_mype, sp%type, sp%ptl(i)%gid, new_phase(1),new_phase(2)
+! print *, 'particle eliminated due to rz_outside :', i, sml_mype, sp%type, sp%ptl(i)%gid, new_phase(1),new_phase(2)
else
!rh 2017/08/01: Modulo operation merged from rhager_3fieldEMsolver
!rh not sure whether it is necessary
@@ -151,8 +144,6 @@ subroutine push(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,dt_ext)
call bounce(new_phase,old_phase,rtn)
if(rtn<0) then
call remove_particle(sp,i,-2,ith)
- num_removed_particles = num_removed_particles + 1
- print *, 'particle eliminated due to rz_outside in bounce', i, sml_mype, sp%type, sp%ptl(i)%gid, new_phase(1),new_phase(2)
endif
endif
@@ -167,9 +158,6 @@ subroutine push(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,dt_ext)
enddo
call t_stopf("PUSH_LOOP")
enddo
- !if (num_removed_particles .gt. 0) then
- ! print *, "subroutine push: num_removed_particles=", num_removed_particles
- !endif
end subroutine push
@@ -327,9 +315,6 @@ subroutine derivs_single(grid,psn,sp,ptli,dy,i,time,fld,ith,diag_on)
real (8) :: vf_diag(sml_n_vf_diag) ! variables for diagnosis
real (8) :: p(3)
integer :: itr
- ! debugging
- integer :: num_removed_particles
- num_removed_particles = 0
! Save space information
fld%r=ptli%ph(1)
@@ -370,17 +355,12 @@ subroutine derivs_single(grid,psn,sp,ptli,dy,i,time,fld,ith,diag_on)
else
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
- print *, 'particle eliminated due to rz_outside in derivs_single', i, sml_mype, sp%type, sp%ptl(i)%gid, fld%r, fld%z
+! print *, 'particle eliminated due to rz_outside', i, sml_mype, sp%type, sp%ptl(i)%gid
endif
!call check_point('before port1')
if(diag_on) call diag_1d_port1(grid,sp%ptl(i),dy,sp%type,vf_diag,ith)
!call check_point('after port1')
-
- if (num_removed_particles .gt. 0) then
- print *, "subroutine derivs_single: num_removed_particles = ", num_removed_particles
- endif
end subroutine derivs_single
subroutine derivs_single_with_e(grid,psn,sp,ptli,dy,i,time,fld,E_mag,ith)
@@ -413,9 +393,6 @@ subroutine derivs_single_with_e(grid,psn,sp,ptli,dy,i,time,fld,E_mag,ith)
real (8) :: wphi(0:1), dweight_exb, wt, xff(2)
integer :: iphi, nd(3), ip
#endif
- ! debugging
- integer :: num_removed_particles
- num_removed_particles = 0
itr=-1
@@ -487,15 +464,8 @@ subroutine derivs_single_with_e(grid,psn,sp,ptli,dy,i,time,fld,E_mag,ith)
else
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
- print *, 'particle eliminated due to rz_outside in deriv_single_with_e: ', i, sml_mype, sp%type, sp%ptl(i)%gid, fld%r, fld%z
- !write(*,'(A30,I10,I4,I2,I7,F6.2,F6.2,F12.2,F6.2,F6.2)') 'particle remove in with_e: ',i, sml_mype, sp%type, sp%ptl(i)%gid, fld%r, fld%z, E_mag(1), E_mag(2), E_mag(3)
! print *, 'particle eliminated due to rz_outside', i, sml_mype, sp%type, sp%ptl(i)%gid
- endif
-
- !if (num_removed_particles .gt. 0) then
- ! print *, "subroutine deriv_single_with_e: num_removed_particles = ", num_removed_particles
- !endif
+ end if
end subroutine derivs_single_with_e
diff --git a/XGC_core/pushe.F90 b/XGC_core/pushe.F90
index 481debb8..bb27462a 100644
--- a/XGC_core/pushe.F90
+++ b/XGC_core/pushe.F90
@@ -7,7 +7,6 @@ subroutine pushe(istep,ncycle,grid,psn,sp,diag_on)
use sml_module
use omp_module , only : split_indices
use perf_monitor
- use diag_module
implicit none
integer, intent(in) :: istep
integer, intent(in) :: ncycle
@@ -22,9 +21,6 @@ subroutine pushe(istep,ncycle,grid,psn,sp,diag_on)
logical, parameter :: use_sort_particles = .true.
- !TODO: Does this have to be allocatable, or can I use sp%num in variable definitions?
- real(kind=8) :: psi_start(sp%num), psi_stop(sp%num), RBpol_start(sp%num), RBpol_stop(sp%num)
-
#ifdef PUSHE_UNIT_READ
if (istep==3) then ! Choose which step of the example you'd like the unit test to come from
call pushe_write_unit_state(istep,ncycle,grid,psn,sp,diag_on,.true.)
@@ -37,20 +33,6 @@ subroutine pushe(istep,ncycle,grid,psn,sp,diag_on)
call t_stopf("pushe_sort_particles")
endif
-
- !TODO Determine if to keep in diag_main_loop, in order to allow crossing over gstep
- if (diag_fullf_turb_period .gt. 0) then
- !create a copy to use as the "reference" point
- !TODO Decide if this should be only for a single pushe step, or across the entire diag_fullf_turb_period
- !TODO: Can I have this diag_fullf_sp_e_start be local to pushe instead of global in a module? In a module only if I need to
- ! to write as in diag_1d_port1 (done within pushe1_step)
- !diag_fullf_sp_e_start%num = num
- !call ptl_mem_allocation( diag_fullf_sp_e_start, 0, sp%maxnum,ptl_mass(0), ptl_charge(0), 1, ptl_lost_nummax)
- !can I do this? Or do I need to explicitly copy arrays? Can I avoid ptl_mem_allocation altogether?
- !diag_fullf_sp_e_start = sp
- call diag_fullf_calc_psi_RBpol(sp,psi_start,RBpol_start)
- endif
-
do icycle=1, ncycle
!
!
@@ -83,20 +65,6 @@ subroutine pushe(istep,ncycle,grid,psn,sp,diag_on)
enddo
call t_stopf("PUSHE_MOD_LOOP")
enddo
-
- if (diag_fullf_turb_period>0) then
- !first, add to the total dr
- call diag_fullf_calc_psi_RBpol(sp,psi_stop,RBpol_stop)
- call diag_fullf_calc_dr(sp,psi_start,RBpol_start,psi_stop,RBpol_stop)
-
- !save the data
- !TODO: Add periodic writeout controlled by input parameter (for now, just write out each subcycle)
- call diag_fullf_tracer(grid,sp,icycle,ncycle)
-
- !make the stop quantities now the start quantities
- psi_start = psi_stop
- RBpol_start = RBpol_stop
- endif
call t_stopf("ELECTRON_LOOP")
enddo
@@ -142,10 +110,6 @@ subroutine pushe_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,icycle)
integer :: ith, i_beg(sml_nthreads), i_end(sml_nthreads)
real (kind=8) , external :: psi_interpol
character (len=5) :: err_str(2)
- ! debugging
- integer :: num_removed_particles
-
- num_removed_particles = 0
err_str(1)='ion'
err_str(2)='elec'
@@ -159,7 +123,6 @@ subroutine pushe_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,icycle)
dt_now=dt
!$OMP PARALLEL DO &
- !$OMP SHARED ( num_removed_particles ), &
!$OMP PRIVATE( ITH, I, NEW_PHASE, &
!$OMP OLD_PHASE, RTN )
do ith=1, sml_nthreads
@@ -179,7 +142,6 @@ subroutine pushe_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,icycle)
! check r-z boundary validity and update psi variables
if(new_phase(1)<eq_min_r .or. new_phase(1)>eq_max_r .or. new_phase(2)<eq_min_z .or. new_phase(2)>eq_max_z)then
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
! print *, 'particle eliminated due to rz_outside :', i, sml_mype, sp%type, sp%ptl(i)%gid, new_phase(1),new_phase(2)
else
! bounce
@@ -189,7 +151,6 @@ subroutine pushe_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,icycle)
call bounce(new_phase,old_phase,rtn)
if(rtn<0) then
call remove_particle(sp,i,-2,ith)
- num_removed_particles = num_removed_particles + 1
endif
endif
@@ -204,10 +165,6 @@ subroutine pushe_1step(istep,ipc,grid,psn,sp,phase0,ptl,diag_on,icycle)
call t_stopf("PUSHE_LOOP")
enddo
- if (num_removed_particles .gt. 0) then
- print *, "subroutine pushe_1step: num_removed_particles = ", num_removed_particles
- endif
-
end subroutine pushe_1step
@@ -333,10 +290,6 @@ subroutine derivs_single_elec(grid,psn,sp,ptli,dy,i,time,fld,ith,diag_on, icycle
!
logical rz_outside
real (8) :: vf_diag(sml_n_vf_diag) ! variables for diagnosis
- ! debugging
- integer :: num_removed_particles
-
- num_removed_particles = 0
! Save space information
#ifdef FIELD_ARRAYS
@@ -359,21 +312,13 @@ subroutine derivs_single_elec(grid,psn,sp,ptli,dy,i,time,fld,ith,diag_on, icycle
else
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
! print *, 'particle eliminated due to rz_outside', i, sml_mype, sp%type, sp%ptl(i)%gid
endif
!call check_point('before port1')
if(diag_on) call diag_1d_port1(grid,sp%ptl(i),dy,sp%type,vf_diag,ith)
- !TODO Need to make sure that the particles are in the same order. Perhaps have to turn on sorting for EACH subcycle?
- !TODO dont use this so deep into the call stack, unless I need to.
- !if(diag_fullf_turb_period>0) call diag_fullf_tracer(grid,psn,diag_fullf_sp_e_start%ptl(i),dy,sp%type,vf_diag,ith)
if(sml_adjust_eden .and. icycle==1) call adjust_eden_port(grid,psn,sp%ptl(i),dy,vf_diag(1),vf_diag(5),ith) ! index 5 gives radial flux
!call check_point('after port1')
-
- if (num_removed_particles .gt. 0) then
- print *, "subroutine derivs_single_elec: num_removed_particles = ", num_removed_particles
- endif
end subroutine derivs_single_elec
subroutine derivs_single_with_e_elec(grid,psn,sp,ptli,dy,i,time,fld,E_mag,ith)
@@ -404,10 +349,6 @@ subroutine derivs_single_with_e_elec(grid,psn,sp,ptli,dy,i,time,fld,E_mag,ith)
real (8) :: dpsi(2), E(3), bp, dtheta_norm(2), B
real (8) :: p(3), x(2), phi, phi_mid, xff(2)
integer :: itr
- ! debugging
- integer :: num_removed_particles
-
- num_removed_particles = 0
itr=-1
@@ -467,13 +408,8 @@ subroutine derivs_single_with_e_elec(grid,psn,sp,ptli,dy,i,time,fld,E_mag,ith)
else
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
! print *, 'particle eliminated due to rz_outside', i, sml_mype, sp%type, sp%ptl(i)%gid
end if
-
- if (num_removed_particles .gt. 0) then
- print *, "subroutine derivs_single_with_e_elec: num_removed_particles = ", num_removed_particles
- endif
end subroutine derivs_single_with_e_elec
diff --git a/XGC_core/resamp_mod.F90 b/XGC_core/resamp_mod.F90
index 14919ff4..177361f3 100644
--- a/XGC_core/resamp_mod.F90
+++ b/XGC_core/resamp_mod.F90
@@ -1410,8 +1410,8 @@ contains
#ifdef XGCA
new_psi(loop) = psi
#endif
- mu_n = real(resamp_tile_size_now,8)*( real(bin%bin_id(2)-1,8) + ranx() )
- vp_n = real(resamp_tile_size_now,8)*( real(bin%bin_id(3)-1,8) + ranx() ) - real(resamp_nvp_in,8)
+ mu_n = resamp_tile_size_now*( (bin%bin_id(2)-1) + ranx() )
+ vp_n = resamp_tile_size_now*( (bin%bin_id(3)-1-resamp_nvp_in/resamp_tile_size_now) + ranx() )
!
bin%new_ptl(loop)%ph(pirho) = (vp_n*resamp_dvp)/ptl_c_m(sp%type) &
/B*sqrt(resamp_t_ev(bin%bin_id(1),sp%type)*sml_ev2j/ptl_mass(sp%type))
@@ -1479,8 +1479,8 @@ contains
wsum(2,1) = wsum(2,1) + vp_n *(1D0-vperp)
wsum(2,2) = wsum(2,2) + vp_n * vperp
- mu_n = real(resamp_tile_size_now,8)*( real(bin%bin_id(2)-1,8) + ranx() )
- vp_n = real(resamp_tile_size_now,8)*( real(bin%bin_id(3)-1,8) + ranx() ) - real(resamp_nvp_in,8)
+ mu_n = resamp_tile_size_now*( (bin%bin_id(2)-1) + vperp )
+ vp_n = resamp_tile_size_now*( (bin%bin_id(3)-1-resamp_nvp_in/resamp_tile_size_now) + vp_n )
!
bin%new_ptl(loop)%ph(pirho) = (vp_n*resamp_dvp)/ptl_c_m(sp%type) &
/B*sqrt(resamp_t_ev(bin%bin_id(1),sp%type)*sml_ev2j/ptl_mass(sp%type))
@@ -1505,7 +1505,7 @@ contains
+ vp_n *(1D0-vperp)/wsum(2,1) * ph_vol_old2(2,1) &
+ vp_n * vperp /wsum(2,2) * ph_vol_old2(2,2)
g = 1D0/g
- if (is_nan_or_inf(g) .or. g .le. 0D0) then
+ if (is_nan_or_inf(g) .or. g==0D0) then
write(*,'(a,12(e13.3,1x))') 'resample_bin: Error: invalid phase-space volume: ',g,vp_n, vperp,wsum,ph_vol_old2,ph_vol_old
stop
endif
@@ -1588,7 +1588,7 @@ contains
g = ph_vol_old2(1,1)/wsum(1,1)
endif
g = 1D0/g
- if (is_nan_or_inf(g) .or. g .le. 0D0) then
+ if (is_nan_or_inf(g) .or. g==0D0) then
write(*,'(a,12(e13.3,1x))') 'resample_bin: Error: invalid phase-space volume: ',g,vp_n, vperp,wsum,ph_vol_old2,ph_vol_old
stop
endif
@@ -1700,7 +1700,7 @@ contains
ierr = loop
write(*,'(a,7(i8,1x))') 'resample_bin: Error: Found w0=0: ', &
sml_mype,bin%bin_id,ierr,num_part,bin%npart
- write(*,'(a,2(e12.4,1x))') 'w0 weight and f0 of particle',bin%new_ptl(loop)%ct(piw0), bin%new_ptl(loop)%ct(pif0)
+ write(*,'(a,e12.4)') 'w0 weight of particle',bin%new_ptl(loop)%ct(piw0)
stop
endif
enddo
diff --git a/XGC_core/shift_ie.F90 b/XGC_core/shift_ie.F90
index 72acf3ea..681da1b9 100644
--- a/XGC_core/shift_ie.F90
+++ b/XGC_core/shift_ie.F90
@@ -26,8 +26,6 @@ module shift_ie_module
real (kind=8) :: phase0(ptl_nphase,sp%maxnum) ! sp%phase0
type(ptl_type) :: ptl(sp%maxnum) ! sp%ptl
integer, optional :: shift_opt(num_shift_ie_opts)
- !
- integer :: num_removed_particles
! shift_ie communication options. Defined in module.F90
! integer, parameter :: num_shift_ie_opts = 10
@@ -159,8 +157,6 @@ module shift_ie_module
call t_startf("SHIFT_IE_INIT")
-
- num_removed_particles = 0
! set parallel algorithm options
max_nthreads = def_max_nthreads
use_alltoall = def_use_alltoall
@@ -316,7 +312,6 @@ module shift_ie_module
call split_indices(sp%num, use_nthreads, i_beg, i_end)
!$OMP PARALLEL DO &
-!$OMP SHARED ( num_removed_particles ), &
!$OMP PRIVATE( ITH, I, PID, ITR, P )
do ith=1,use_nthreads
call t_startf("SHIFT_IE_LOOP1")
@@ -357,9 +352,7 @@ module shift_ie_module
endif
pid_part(i)=pid
else
- print *, "subroutine shift_ie: particle ",i," is not in the grid"
call remove_particle(sp,i,-1,ith)
- num_removed_particles = num_removed_particles + 1
pid_part(i)=my_pid
endif
enddo
@@ -953,10 +946,6 @@ module shift_ie_module
call assert( alloc_stat .eq. 0, &
'shift_ie: dealloc(shift_ie buffers) return istat=',alloc_stat)
- if (num_removed_particles .gt. 0) then
- print *, "subroutine shift_ie: num_removed_particles = ", num_removed_particles
- endif
-
end subroutine shift_ie
!
!------------------------------------------------------------------------------
diff --git a/XGCa/diagnosis.F90 b/XGCa/diagnosis.F90
index ac74aec1..09f263cf 100644
--- a/XGCa/diagnosis.F90
+++ b/XGCa/diagnosis.F90
@@ -2784,8 +2784,8 @@ subroutine diag_sheath(grid)
! open ADIOS
!rh Generate file in first time step for nwo
- !jc Need to check global time to enable appending after restarting.
- if(sml_gstep/diag_1d_period==1) then
+ !if(sml_gstep/diag_1d_period==1) then
+ if(sml_istep/diag_1d_period==1) then
ADIOS_OPEN(buf_id,'diagnosis.sheath','xgc.sheathdiag.bp','w',sml_comm_null,err)
else
ADIOS_OPEN(buf_id,'diagnosis.sheath','xgc.sheathdiag.bp','a',sml_comm_null,err)
diff --git a/build/defs.mk b/build/defs.mk
index 82ba8c78..fa7a65c6 100644
--- a/build/defs.mk
+++ b/build/defs.mk
@@ -26,12 +26,12 @@ OBJ_COMMON = build_info.o module.o tiny_functions.o \
OBJ_COMMON_EXTRA_XGC1 = initial_perturbation.o
OBJ_COMMON_F0 = resamp_mod.o load_balance_mod.o \
- dcx_coupling_mod.o restart_mod.o load.o \
+ restart_mod.o load.o \
charge_common.o collisionf.o collisionf2.o \
neutral_totalf.o coupling_mod.o f0analysis_module.o \
diagnosis_comm.o global_particle_check.o
-OBJ_COMMON_STAGE2 = main_loop_f90_routines.o main_loop.o diag_main_loop.o
+OBJ_COMMON_STAGE2 = main_loop_f90_routines.o main_loop.o
OBJ_XGCA = coupling_mod.o charge.o setup.o \
diagnosis.o poisson_extra_xgca.o poisson.o \
@@ -41,7 +41,7 @@ OBJ_XGC1 = coupling_mod.o charge.o interfaces.o \
setup.o diagnosis.o poisson_extra_xgc1.o \
neutral.o neutral2.o \
neutral3.o gather_field_info.o interfaces.o \
- limiter.o diag_fullf.o
+ limiter.o
OBJ_XGC1_ES = es_main.o es_poisson.o
diff --git a/build/make.inc.cori_haswell b/build/make.inc.cori_haswell
index 5ea3f86c..4d88c4b6 100644
--- a/build/make.inc.cori_haswell
+++ b/build/make.inc.cori_haswell
@@ -43,7 +43,7 @@ USER_LIB_DIR=/project/projectdirs/m499/Software
### PETSc
#####################################################
#
-PETSC_DIR=$(USER_LIB_DIR)/petsc/DEFAULT/$(XGC_PLATFORM)/intel
+PETSC_DIR=$(USER_LIB_DIR)/petsc/DEFAULT/$(XGC_PLATFORM)/DEFAULT
#
include ${PETSC_DIR}/lib/petsc/conf/variables
#
@@ -87,7 +87,7 @@ ADIOS_DIR=$(USER_LIB_DIR)/adios/DEFAULT/$(XGC_PLATFORM)/DEFAULT
ADIOS_INC=$(shell $(ADIOS_DIR)/bin/adios_config -f -c)
ADIOS_LIB=$(shell $(ADIOS_DIR)/bin/adios_config -f -l)
#
-ADIOS2_DIR=$(USER_LIB_DIR)/adios2/DEFAULT/$(XGC_PLATFORM)/intel-static
+ADIOS2_DIR=$(USER_LIB_DIR)/adios2/DEFAULT/$(XGC_PLATFORM)/DEFAULT
ADIOS2_INC=$(shell $(ADIOS2_DIR)/bin/adios2-config --fortran-flags)
ADIOS2_LIB=$(shell $(ADIOS2_DIR)/bin/adios2-config --fortran-libs --cxx-libs)
#
@@ -199,7 +199,7 @@ LD_CAB=CC
ifeq ($(DEBUG),1)
FFLAGS=-qopenmp -O0 -no-ipo -traceback -g -C
else
- FFLAGS=-qopenmp -O3 -no-ipo -traceback -g -C
+ FFLAGS=-qopenmp -O3 -no-ipo -traceback
endif
#
#
diff --git a/build/rules.mk b/build/rules.mk
index e6555ae5..3e440e49 100644
--- a/build/rules.mk
+++ b/build/rules.mk
@@ -53,9 +53,6 @@ xgca-cab: build_dir xgca_build cab_build print_config objects_stage1 objects_cab
xgc-es: build_dir xgc1_build es_build print_config objects_stage1 objects_stage2
cd $(PREFIX) ; $(LD) $(FFLAGS) -o xgc-es *.o $(XGC_LIB)
-xgc-es-diagfullf: build_dir xgc1_diagfullf_build es_build print_config objects_stage1 objects_stage2
- cd $(PREFIX) ; $(LD) $(FFLAGS) -o xgc-es-diagfullf *.o $(XGC_LIB)
-
resamp_unit: build_dir xgc1_build unit_build print_config objects_stage1 objects_stage2
cd $(PREFIX) ; $(LD) $(FFLAGS) -o res_unit1 *.o $(XGC_LIB)
@@ -204,17 +201,6 @@ xgc1_build:
$(eval XGC_FLAGS += -DXGC1)
$(eval OBJ_COMMON += $(OBJ_COMMON_EXTRA_XGC1))
-xgc1_diagfullf_build:
- @echo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- @echo !!! Building XGC DIAG FULLF
- @echo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- @echo ' '
- $(eval EM_BUILD := 0)
- $(eval USE_VEC := 0)
- $(eval CODE_PATH := XGC1)
- $(eval XGC_FLAGS += -DXGC1 -DDIAG_FULLF)
- $(eval OBJ_COMMON += $(OBJ_COMMON_EXTRA_XGC1))
-
xgcs_build:
@echo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@echo !!! Building XGC-S
@@ -286,8 +272,8 @@ print_config:
@echo ' '
clean:
- cd XGC_core ; rm -f build_info.F90 *.mod *.smod
- cd $(PREFIX) ; rm -f *.o *.mod *.smod *.lst *.s *.out
+ cd XGC_core ; rm -f build_info.F90
+ cd $(PREFIX) ; rm -f *.o *.mod *.lst *.s *.out
print-% : ; @echo $* = $($*)
diff --git a/build/xgc_flags.mk b/build/xgc_flags.mk
index 76f3ece7..59e319bd 100644
--- a/build/xgc_flags.mk
+++ b/build/xgc_flags.mk
@@ -3,7 +3,6 @@
################################################
#
XGC_FLAGS += -DITER_GRID -DCAM_TIMERS
-XGC_FLAGS += -DADIOS2
#
# For timing library
diff --git a/utils/check_inputs.py b/utils/check_inputs.py
deleted file mode 100755
index 83c40b6f..00000000
--- a/utils/check_inputs.py
+++ /dev/null
@@ -1,66 +0,0 @@
-#!/usr/bin python
-
-#read in the XGC namelists and check an input file against them.
-#Useful to determine if an old input file is still valid
-#
-#Example use:
-# python check_inputs.py <path to XGC-Devel setup.F90> <path to input>
-#e.g.
-# python check_inputs.py ~/XGC-Devel/XGCa/setup.F90 ./input
-
-import sys, os
-
-fileSetup = sys.argv[1]
-fileInput = sys.argv[2]
-
-assert os.path.exists(fileSetup)
-assert os.path.exists(fileInput)
-
-#read in namelists and variables from setup.F90
-namelists = {}
-inlist = False
-with open(fileSetup,'r') as fs:
- for line in fs:
- if 'namelist' in line:
- if 'namelist' in line.split()[0]:
- inlist = True
- name = line.split('/')[1].strip().lower()
- namelists[name] = []
- if inlist:
- aftername = line.split('/')[-1].split('!')[0]
- varlist = aftername.split(',')
- #remove line continuation from list
- if varlist[-1].strip()=='&':
- varlist = varlist[:-1]
- else:
- inlist=False
- varlist = [var.strip().lower() for var in varlist]
- namelists[name] = namelists.get(name,[]) + varlist
-
-#read in namelists and variables from the input file, print where different
-namelists_input = []
-inlist = False
-with open(fileInput,'r') as fi:
- for line in fi:
- if line[0]=='&': #this is a namelist
- inlist = True
- name = line[1:].split()[0].strip().lower()
- namelists_input.append(name)
- if not name in namelists.keys():
- print('Remove input file namelist '+name+' (NOT found in setup.F90)')
- elif not line.strip(): #blank line
- continue
- elif line.strip()[0]=='!': #comment
- continue
- elif line[0]=='/': #end namelist
- inlist = False
- elif inlist:
- var = line.split('=')[0].strip().lower()
- if name in namelists.keys():
- if not var in namelists[name]:
- print('Remove input file variable ' + var + ' (NOT found in namelist '+name + ' in setup.F90)')
-
-#print also namelists missing from the input file (which will also throw an error)
-for name in namelists.keys():
- if not name in namelists_input:
- print('Add namelist '+name+' (NOT found in input)')
diff --git a/utils/kernels/col_kernel/col_f_module.F90 b/utils/kernels/col_kernel/col_f_module.F90
index fde3e3f9..6d54f390 100644
--- a/utils/kernels/col_kernel/col_f_module.F90
+++ b/utils/kernels/col_kernel/col_f_module.F90
@@ -460,15 +460,15 @@ module col_f_module
deallocate(col_sp_cell_all, stat=alloc_stat)
deallocate(gammac_spall, stat=alloc_stat)
+ deallocate(M_s, stat=alloc_stat)
#ifdef _OPENACC
!$acc exit data delete(M_s)
#endif
- deallocate(M_s, stat=alloc_stat)
if(col_f_sp_num .gt. 1) then
+ deallocate(M_ab, stat=alloc_stat)
#ifdef _OPENACC
!$acc exit data delete(M_ab)
#endif
- deallocate(M_ab, stat=alloc_stat)
endif
return
diff --git a/xgc_build/xgc_flags.out b/xgc_build/xgc_flags.out
deleted file mode 100644
index 28f51ed8..00000000
--- a/xgc_build/xgc_flags.out
+++ /dev/null
@@ -1,6 +0,0 @@
--DPSPLINE -DUSE_BICUB_MOD &
--DUSE_ONE_D_I_CUB_MOD &
--DV_PERP -DSOLVERLU &
--DUSE_INQUIRE_DIRECTORY &
--DITER_GRID -DCAM_TIMERS &
--DADIOS2 -DXGC1&
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment