diff --git a/matlab/profiler.m b/matlab/profiler.m index a8184e1..86d73e4 100644 --- a/matlab/profiler.m +++ b/matlab/profiler.m @@ -1,103 +1,104 @@ %% load profiling % filename = sprintf([BASIC.RESDIR,'outputs_%.2d.h5'],00); % outfilename = ['/misc/HeLaZ_outputs',filename(3:end)]; outfilename = data.outfilenames{end}; CPUTIME = double(h5readatt(outfilename,'/data/input','cpu_time')); DT_SIM = h5readatt(outfilename,'/data/input','dt'); rhs_Tc = h5read(outfilename,'/profiler/Tc_rhs'); +poisson_Tc = h5read(outfilename,'/profiler/Tc_poisson'); +Sapj_Tc = h5read(outfilename,'/profiler/Tc_Sapj'); +coll_Tc = h5read(outfilename,'/profiler/Tc_coll'); +process_Tc = h5read(outfilename,'/profiler/Tc_process'); adv_field_Tc = h5read(outfilename,'/profiler/Tc_adv_field'); ghost_Tc = h5read(outfilename,'/profiler/Tc_ghost'); clos_Tc = h5read(outfilename,'/profiler/Tc_clos'); -coll_Tc = h5read(outfilename,'/profiler/Tc_coll'); -poisson_Tc = h5read(outfilename,'/profiler/Tc_poisson'); -Sapj_Tc = h5read(outfilename,'/profiler/Tc_Sapj'); checkfield_Tc= h5read(outfilename,'/profiler/Tc_checkfield'); diag_Tc = h5read(outfilename,'/profiler/Tc_diag'); -process_Tc = h5read(outfilename,'/profiler/Tc_process'); step_Tc = h5read(outfilename,'/profiler/Tc_step'); Ts0D = h5read(outfilename,'/profiler/time'); N_T = 11; missing_Tc = step_Tc - rhs_Tc - adv_field_Tc - ghost_Tc -clos_Tc ... -coll_Tc -poisson_Tc -Sapj_Tc -checkfield_Tc -diag_Tc-process_Tc; total_Tc = step_Tc; TIME_PER_FCT = [diff(rhs_Tc); diff(adv_field_Tc); diff(ghost_Tc);... diff(clos_Tc); diff(coll_Tc); diff(poisson_Tc); diff(Sapj_Tc); ... diff(checkfield_Tc); diff(diag_Tc); diff(process_Tc); diff(missing_Tc)]; TIME_PER_FCT = reshape(TIME_PER_FCT,[numel(TIME_PER_FCT)/N_T,N_T]); TIME_PER_STEP = sum(TIME_PER_FCT,2); TIME_PER_CPU = trapz(Ts0D(2:end),TIME_PER_STEP); rhs_Ta = mean(diff(rhs_Tc)); adv_field_Ta = mean(diff(adv_field_Tc)); ghost_Ta = mean(diff(ghost_Tc)); clos_Ta = mean(diff(clos_Tc)); coll_Ta = mean(diff(coll_Tc)); poisson_Ta = mean(diff(poisson_Tc)); Sapj_Ta = mean(diff(Sapj_Tc)); checkfield_Ta = mean(diff(checkfield_Tc)); process_Ta = mean(diff(process_Tc)); diag_Ta = mean(diff(diag_Tc)); NSTEP_PER_SAMP= mean(diff(Ts0D))/DT_SIM; %% Plots if 1 %% Area plot fig = figure; % colors = rand(N_T,3); colors = lines(N_T); p1 = area(Ts0D(2:end),TIME_PER_FCT,'LineStyle','none'); for i = 1:N_T; p1(i).FaceColor = colors(i,:); end; legend('Compute RHS','Adv. fields','ghosts comm', 'closure', 'collision','Poisson','Nonlin','Check+sym', 'Diagnos.', 'Process', 'Missing') xlabel('Sim. Time [$\rho_s/c_s$]'); ylabel('Step Comp. Time [s]') xlim([Ts0D(2),Ts0D(end)]); title(sprintf('Proc. 1, total sim. time ~%.0f [h]',CPUTIME/3600)) hold on FIGNAME = 'profiler'; % save_figure else %% Normalized Area plot fig = figure; - +colors = colorcube(N_T); p1 = area(Ts0D(2:end),100*TIME_PER_FCT./diff(total_Tc),'LineStyle','none', 'FaceColor','flat'); -for i = 1:N_T; p1(i).FaceColor = rand(1,3); end; +% for i = 1:N_T; p1(i).FaceColor = rand(1,3); end; +for i = 1:N_T; p1(i).FaceColor = colors(i,:); end; legend('Compute RHS','Adv. fields','ghosts comm', 'closure', 'collision','Poisson','Nonlin','Check+sym', 'Diagnos.', 'Missing') xlabel('Sim. Time'); ylabel('Step Comp. Time [\%]') ylim([0,100]); xlim([Ts0D(2),Ts0D(end)]); hold on yyaxis right p2 = plot(Ts0D(2:end),diff(total_Tc),'--r','LineWidth',1.0); ylabel('Step Comp. Time [s]') ylim([0,1.1*max(diff(total_Tc))]) set(gca,'ycolor','r') FIGNAME = 'profiler'; % save_figure end if 0 %% Histograms fig = figure; histogram(diff(rhs_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(adv_field_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(ghost_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(clos_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(coll_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(poisson_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(Sapj_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(process_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(checkfield_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on histogram(diff(diag_Tc)/NSTEP_PER_SAMP,'Normalization','probability');hold on grid on; legend('Compute RHS','Adv. fields','Ghosts comm', 'closure', 'collision','Poisson','Nonlin','Process','Check+sym', 'Diagnos.', 'Missing') xlabel('Step Comp. Time [s]'); ylabel('') set(gca,'Xscale','log') FIGNAME = 'profiler'; % save_figure end \ No newline at end of file diff --git a/src/basic_mod.F90 b/src/basic_mod.F90 index ece5f9b..c0ae90b 100644 --- a/src/basic_mod.F90 +++ b/src/basic_mod.F90 @@ -1,374 +1,381 @@ MODULE basic ! Basic module for time dependent problems use, intrinsic :: iso_c_binding use prec_const IMPLICIT none ! INCLUDE 'fftw3-mpi.f03' INTEGER :: nrun = 1 ! Number of time steps to run real(dp) :: tmax = 100000.0 ! Maximum simulation time real(dp) :: dt = 1.0 ! Time step real(dp) :: time = 0 ! Current simulation time (Init from restart file) INTEGER :: comm0 ! Default communicator with a topology INTEGER :: group0 ! Default group with a topology INTEGER :: rank_0 ! Ranks in comm0 ! Communicators for 1-dim cartesian subgrids of comm0 INTEGER :: comm_p, comm_ky, comm_z INTEGER :: rank_p, rank_ky, rank_z! Ranks INTEGER :: comm_pz, rank_pz ! 2D comm for N_a(p,j,z) output (mspfile) INTEGER :: comm_kyz, rank_kyz ! 2D comm for N_a(p,j,z) output (mspfile) INTEGER :: comm_ky0, rank_ky0 ! comm along ky with p=0 INTEGER :: comm_z0, rank_z0 ! comm along z with p=0 INTEGER :: group_ky0, group_z0 INTEGER :: jobnum = 0 ! Job number INTEGER :: step = 0 ! Calculation step of this run INTEGER :: cstep = 0 ! Current step number (Init from restart file) LOGICAL :: nlend = .FALSE. ! Signal end of run LOGICAL :: crashed = .FALSE. ! Signal end of crashed run INTEGER :: ierr ! flag for MPI error INTEGER :: my_id ! Rank in COMM_WORLD INTEGER :: num_procs ! number of MPI processes INTEGER :: num_procs_p ! Number of processes in p INTEGER :: num_procs_ky ! Number of processes in r INTEGER :: num_procs_z ! Number of processes in z INTEGER :: num_procs_pz ! Number of processes in pz comm INTEGER :: num_procs_kyz ! Number of processes in kyz comm INTEGER :: nbr_L, nbr_R ! Left and right neighbours (along p) INTEGER :: nbr_T, nbr_B ! Top and bottom neighbours (along kx) INTEGER :: nbr_U, nbr_D ! Upstream and downstream neighbours (along z) INTEGER :: iframe0d ! counting the number of times 0d datasets are outputed (for diagnose) INTEGER :: iframe1d ! counting the number of times 1d datasets are outputed (for diagnose) INTEGER :: iframe2d ! counting the number of times 2d datasets are outputed (for diagnose) INTEGER :: iframe3d ! counting the number of times 3d datasets are outputed (for diagnose) INTEGER :: iframe5d ! counting the number of times 5d datasets are outputed (for diagnose) ! List of logical file units INTEGER :: lu_in = 90 ! File duplicated from STDIN INTEGER :: lu_stop = 91 ! stop file, see subroutine TESEND ! To measure computation time real :: start, finish real(dp) :: t0_rhs, t0_adv_field, t0_poisson, t0_Sapj, t0_diag, t0_checkfield,& t0_step, t0_clos, t0_ghost, t0_coll, t0_process real(dp) :: t1_rhs, t1_adv_field, t1_poisson, t1_Sapj, t1_diag, t1_checkfield,& t1_step, t1_clos, t1_ghost, t1_coll, t1_process real(dp) :: tc_rhs, tc_adv_field, tc_poisson, tc_Sapj, tc_diag, tc_checkfield,& tc_step, tc_clos, tc_ghost, tc_coll, tc_process real(dp) :: maxruntime = 1e9 ! Maximum simulation CPU time LOGICAL :: GATHERV_OUTPUT = .true. INTERFACE allocate_array MODULE PROCEDURE allocate_array_dp1,allocate_array_dp2,allocate_array_dp3,allocate_array_dp4, allocate_array_dp5, allocate_array_dp6 MODULE PROCEDURE allocate_array_dc1,allocate_array_dc2,allocate_array_dc3,allocate_array_dc4, allocate_array_dc5, allocate_array_dc6 MODULE PROCEDURE allocate_array_i1,allocate_array_i2,allocate_array_i3,allocate_array_i4 MODULE PROCEDURE allocate_array_l1,allocate_array_l2,allocate_array_l3,allocate_array_l4 END INTERFACE allocate_array CONTAINS !================================================================================ SUBROUTINE basic_data ! Read basic data for input file use prec_const IMPLICIT NONE NAMELIST /BASIC/ nrun, dt, tmax, maxruntime CALL find_input_file READ(lu_in,basic) !Init cumulative timers - tc_rhs = 0.; tc_adv_field = 0.; tc_poisson = 0. - tc_Sapj = 0.; tc_diag = 0.; tc_checkfield = 0. - tc_ghost = 0.; tc_coll = 0.; tc_process = 0. - tc_clos = 0.; tc_step = 0.; + tc_rhs = 0. + tc_poisson = 0. + tc_Sapj = 0. + tc_coll = 0. + tc_process = 0. + tc_adv_field = 0. + tc_ghost = 0. + tc_clos = 0. + tc_checkfield = 0. + tc_diag = 0. + tc_step = 0. END SUBROUTINE basic_data SUBROUTINE basic_outputinputs(fid, str) ! ! Write the input parameters to the results_xx.h5 file ! USE prec_const USE futils, ONLY: attach IMPLICIT NONE INTEGER, INTENT(in) :: fid CHARACTER(len=256), INTENT(in) :: str CALL attach(fid, TRIM(str), "start_iframe0d", iframe0d) CALL attach(fid, TRIM(str), "start_iframe2d", iframe2d) CALL attach(fid, TRIM(str), "start_iframe3d", iframe3d) CALL attach(fid, TRIM(str), "start_iframe5d", iframe5d) CALL attach(fid, TRIM(str), "start_time", time) CALL attach(fid, TRIM(str), "start_cstep", cstep-1) CALL attach(fid, TRIM(str), "dt", dt) CALL attach(fid, TRIM(str), "tmax", tmax) CALL attach(fid, TRIM(str), "nrun", nrun) CALL attach(fid, TRIM(str), "cpu_time", -1) CALL attach(fid, TRIM(str), "Nproc", num_procs) CALL attach(fid, TRIM(str), "Np_p" , num_procs_p) CALL attach(fid, TRIM(str), "Np_kx",num_procs_ky) CALL attach(fid, TRIM(str), "Np_z", num_procs_z) END SUBROUTINE basic_outputinputs !================================================================================ SUBROUTINE find_input_file IMPLICIT NONE CHARACTER(len=32) :: str, input_file INTEGER :: nargs, fileid, l LOGICAL :: mlexist nargs = COMMAND_ARGUMENT_COUNT() IF((nargs .EQ. 1) .OR. (nargs .EQ. 4)) THEN CALL GET_COMMAND_ARGUMENT(nargs, str, l, ierr) READ(str(1:l),'(i3)') fileid WRITE(input_file,'(a,a1,i2.2,a3)') 'fort','_',fileid,'.90' INQUIRE(file=input_file, exist=mlexist) IF( mlexist ) THEN IF(my_id.EQ.0) write(*,*) 'Reading input ', input_file,'...' OPEN(lu_in, file=input_file) ELSE IF(my_id.EQ.0) write(*,*) 'Reading input fort.90...' OPEN(lu_in, file='fort.90') ENDIF ENDIF END SUBROUTINE find_input_file !================================================================================ SUBROUTINE daytim(str) ! Print date and time use prec_const IMPLICIT NONE CHARACTER(len=*) , INTENT(in) :: str CHARACTER(len=16) :: d, t, dat, time !________________________________________________________________________________ ! CALL DATE_AND_TIME(d,t) dat=d(7:8) // '/' // d(5:6) // '/' // d(1:4) time=t(1:2) // ':' // t(3:4) // ':' // t(5:10) WRITE(*,'(a,1x,a,1x,a)') str, dat(1:10), time(1:12) ! END SUBROUTINE daytim !================================================================================ SUBROUTINE display_h_min_s(time) real :: time integer :: days, hours, mins, secs days = FLOOR(time/24./3600.); hours= FLOOR(time/3600.); mins = FLOOR(time/60.); secs = FLOOR(time); IF ( days .GT. 0 ) THEN !display day h min s hours = (time/3600./24. - days) * 24 mins = (time/3600. - days*24. - hours) * 60 secs = (time/60. - days*24.*60 - hours*60 - mins) * 60 IF (my_id .EQ. 0) WRITE(*,*) 'CPU Time = ', days, '[day]', hours, '[h]', mins, '[min]', secs, '[s]' IF (my_id .EQ. 0) WRITE(*,*) '(',time,'[s])' ELSEIF ( hours .GT. 0 ) THEN !display h min s mins = (time/3600. - hours) * 60 secs = (time/60. - hours*60 - mins) * 60 IF (my_id .EQ. 0) WRITE(*,*) 'CPU Time = ', hours, '[h]', mins, '[min]', secs, '[s]' IF (my_id .EQ. 0) WRITE(*,*) '(',time,'[s])' ELSEIF ( mins .GT. 0 ) THEN !display min s secs = (time/60. - mins) * 60 IF (my_id .EQ. 0) WRITE(*,*) 'CPU Time = ', mins, '[min]', secs, '[s]' IF (my_id .EQ. 0) WRITE(*,*) '(',time,'[s])' ELSE ! display s IF (my_id .EQ. 0) WRITE(*,*) 'CPU Time = ', FLOOR(time), '[s]' ENDIF END SUBROUTINE display_h_min_s !================================================================================ ! To allocate arrays of doubles, integers, etc. at run time SUBROUTINE allocate_array_dp1(a,is1,ie1) IMPLICIT NONE real(dp), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1 ALLOCATE(a(is1:ie1)) a=0.0_dp END SUBROUTINE allocate_array_dp1 SUBROUTINE allocate_array_dp2(a,is1,ie1,is2,ie2) IMPLICIT NONE real(dp), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2 ALLOCATE(a(is1:ie1,is2:ie2)) a=0.0_dp END SUBROUTINE allocate_array_dp2 SUBROUTINE allocate_array_dp3(a,is1,ie1,is2,ie2,is3,ie3) IMPLICIT NONE real(dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3)) a=0.0_dp END SUBROUTINE allocate_array_dp3 SUBROUTINE allocate_array_dp4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4) IMPLICIT NONE real(dp), DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4)) a=0.0_dp END SUBROUTINE allocate_array_dp4 SUBROUTINE allocate_array_dp5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5) IMPLICIT NONE real(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5)) a=0.0_dp END SUBROUTINE allocate_array_dp5 SUBROUTINE allocate_array_dp6(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6) IMPLICIT NONE real(dp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5,is6:ie6)) a=0.0_dp END SUBROUTINE allocate_array_dp6 !======================================== SUBROUTINE allocate_array_dc1(a,is1,ie1) IMPLICIT NONE DOUBLE COMPLEX, DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1 ALLOCATE(a(is1:ie1)) a=CMPLX(0.0_dp,0.0_dp) END SUBROUTINE allocate_array_dc1 SUBROUTINE allocate_array_dc2(a,is1,ie1,is2,ie2) IMPLICIT NONE DOUBLE COMPLEX, DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2 ALLOCATE(a(is1:ie1,is2:ie2)) a=CMPLX(0.0_dp,0.0_dp) END SUBROUTINE allocate_array_dc2 SUBROUTINE allocate_array_dc3(a,is1,ie1,is2,ie2,is3,ie3) IMPLICIT NONE DOUBLE COMPLEX, DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3)) a=CMPLX(0.0_dp,0.0_dp) END SUBROUTINE allocate_array_dc3 SUBROUTINE allocate_array_dc4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4) IMPLICIT NONE DOUBLE COMPLEX, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4)) a=CMPLX(0.0_dp,0.0_dp) END SUBROUTINE allocate_array_dc4 SUBROUTINE allocate_array_dc5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5) IMPLICIT NONE DOUBLE COMPLEX, DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5)) a=CMPLX(0.0_dp,0.0_dp) END SUBROUTINE allocate_array_dc5 SUBROUTINE allocate_array_dc6(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6) IMPLICIT NONE DOUBLE COMPLEX, DIMENSION(:,:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5,is6:ie6)) a=CMPLX(0.0_dp,0.0_dp) END SUBROUTINE allocate_array_dc6 !======================================== SUBROUTINE allocate_array_i1(a,is1,ie1) IMPLICIT NONE INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1 ALLOCATE(a(is1:ie1)) a=0 END SUBROUTINE allocate_array_i1 SUBROUTINE allocate_array_i2(a,is1,ie1,is2,ie2) IMPLICIT NONE INTEGER, DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2 ALLOCATE(a(is1:ie1,is2:ie2)) a=0 END SUBROUTINE allocate_array_i2 SUBROUTINE allocate_array_i3(a,is1,ie1,is2,ie2,is3,ie3) IMPLICIT NONE INTEGER, DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3)) a=0 END SUBROUTINE allocate_array_i3 SUBROUTINE allocate_array_i4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4) IMPLICIT NONE INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4)) a=0 END SUBROUTINE allocate_array_i4 SUBROUTINE allocate_array_i5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5) IMPLICIT NONE real(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5)) a=0 END SUBROUTINE allocate_array_i5 !======================================== SUBROUTINE allocate_array_l1(a,is1,ie1) IMPLICIT NONE LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1 ALLOCATE(a(is1:ie1)) a=.false. END SUBROUTINE allocate_array_l1 SUBROUTINE allocate_array_l2(a,is1,ie1,is2,ie2) IMPLICIT NONE LOGICAL, DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2 ALLOCATE(a(is1:ie1,is2:ie2)) a=.false. END SUBROUTINE allocate_array_l2 SUBROUTINE allocate_array_l3(a,is1,ie1,is2,ie2,is3,ie3) IMPLICIT NONE LOGICAL, DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3)) a=.false. END SUBROUTINE allocate_array_l3 SUBROUTINE allocate_array_l4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4) IMPLICIT NONE LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4)) a=.false. END SUBROUTINE allocate_array_l4 SUBROUTINE allocate_array_l5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5) IMPLICIT NONE LOGICAL, DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5)) a=.false. END SUBROUTINE allocate_array_l5 END MODULE basic diff --git a/src/diagnose.F90 b/src/diagnose.F90 index 912baa9..008b4f5 100644 --- a/src/diagnose.F90 +++ b/src/diagnose.F90 @@ -1,645 +1,645 @@ SUBROUTINE diagnose(kstep) ! Diagnostics, writing simulation state to disk USE basic USE diagnostics_par USE processing, ONLY: gflux_ri, hflux_xi IMPLICIT NONE INTEGER, INTENT(in) :: kstep CALL cpu_time(t0_diag) ! Measuring time !! Basic diagnose loop for reading input file, displaying advancement and ending IF ((kstep .EQ. 0)) THEN INQUIRE(unit=lu_in, name=input_fname) CLOSE(lu_in) ENDIF IF (kstep .GE. 0) THEN ! Terminal info IF (MOD(cstep, INT(1.0/dt)) == 0 .AND. (my_id .EQ. 0)) THEN ! WRITE(*,"(F6.0,A,F6.0)") time,"/",tmax WRITE(*,"(A,F6.0,A1,F6.0,A8,G10.2,A8,G10.2,A)")'|t/tmax = ', time,"/",tmax,'| Gxi = ',gflux_ri,'| Qxi = ',hflux_xi,'|' ENDIF ELSEIF (kstep .EQ. -1) THEN CALL cpu_time(finish) ! Display computational time cost IF (my_id .EQ. 0) CALL display_h_min_s(finish-start) END IF !! Specific diagnostic calls CALL diagnose_full(kstep) CALL cpu_time(t1_diag); tc_diag = tc_diag + (t1_diag - t0_diag) END SUBROUTINE diagnose SUBROUTINE init_outfile(comm,file0,file,fid) USE diagnostics_par, ONLY : write_doubleprecision, diag_par_outputinputs, input_fname USE basic, ONLY : my_id, jobnum, basic_outputinputs USE grid, ONLY : grid_outputinputs USE geometry, ONLY : geometry_outputinputs USE model, ONLY : model_outputinputs USE collision, ONLY : coll_outputinputs USE initial_par, ONLY : initial_outputinputs USE time_integration,ONLY : time_integration_outputinputs USE futils, ONLY : creatf, creatg, creatd, attach, putfile IMPLICIT NONE !input INTEGER, INTENT(IN) :: comm CHARACTER(len=256), INTENT(IN) :: file0 CHARACTER(len=256), INTENT(OUT) :: file INTEGER, INTENT(OUT) :: fid CHARACTER(len=256) :: str INCLUDE 'srcinfo.h' ! Writing output filename WRITE(file,'(a,a1,i2.2,a3)') TRIM(file0) ,'_',jobnum,'.h5' ! 1.1 Initial run ! Main output file creation IF (write_doubleprecision) THEN CALL creatf(file, fid, real_prec='d', mpicomm=comm) ELSE CALL creatf(file, fid, mpicomm=comm) END IF IF (my_id .EQ. 0) WRITE(*,'(3x,a,a)') TRIM(file), ' created' ! basic data group CALL creatg(fid, "/data", "data") ! File group CALL creatg(fid, "/files", "files") CALL attach(fid, "/files", "jobnum", jobnum) ! Add the code info and parameters to the file WRITE(str,'(a,i2.2)') "/data/input" CALL creatd(fid, 0,(/0/),TRIM(str),'Input parameters') CALL attach(fid, TRIM(str), "version", VERSION) !defined in srcinfo.h CALL attach(fid, TRIM(str), "branch", BRANCH) !defined in srcinfo.h CALL attach(fid, TRIM(str), "author", AUTHOR) !defined in srcinfo.h CALL attach(fid, TRIM(str), "execdate", EXECDATE) !defined in srcinfo.h CALL attach(fid, TRIM(str), "host", HOST) !defined in srcinfo.h CALL basic_outputinputs(fid,str) CALL grid_outputinputs(fid, str) CALL geometry_outputinputs(fid, str) CALL diag_par_outputinputs(fid, str) CALL model_outputinputs(fid, str) CALL coll_outputinputs(fid, str) CALL initial_outputinputs(fid, str) CALL time_integration_outputinputs(fid, str) ! Save STDIN (input file) of this run IF(jobnum .LE. 99) THEN WRITE(str,'(a,i2.2)') "/files/STDIN.",jobnum ELSE WRITE(str,'(a,i3.2)') "/files/STDIN.",jobnum END IF CALL putfile(fid, TRIM(str), TRIM(input_fname),ionode=0) END SUBROUTINE init_outfile SUBROUTINE diagnose_full(kstep) USE basic USE grid USE diagnostics_par USE futils, ONLY: creatf, creatg, creatd, closef, putarr, putfile, attach, openf, putarrnd USE array USE model USE initial_par USE fields USE time_integration USE parallel USE prec_const USE collision, ONLY: coll_outputinputs USE geometry IMPLICIT NONE INTEGER, INTENT(in) :: kstep INTEGER, parameter :: BUFSIZE = 2 INTEGER :: rank = 0 INTEGER :: dims(1) = (/0/) !____________________________________________________________________________ ! 1. Initial diagnostics IF ((kstep .EQ. 0)) THEN CALL init_outfile(comm0, resfile0,resfile,fidres) ! Profiler time measurement CALL creatg(fidres, "/profiler", "performance analysis") CALL creatd(fidres, 0, dims, "/profiler/Tc_rhs", "cumulative rhs computation time") - CALL creatd(fidres, 0, dims, "/profiler/Tc_adv_field", "cumulative adv. fields computation time") - CALL creatd(fidres, 0, dims, "/profiler/Tc_clos", "cumulative closure computation time") - CALL creatd(fidres, 0, dims, "/profiler/Tc_ghost", "cumulative communication time") - CALL creatd(fidres, 0, dims, "/profiler/Tc_coll", "cumulative collision computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_poisson", "cumulative poisson computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_Sapj", "cumulative Sapj computation time") + CALL creatd(fidres, 0, dims, "/profiler/Tc_coll", "cumulative collision computation time") + CALL creatd(fidres, 0, dims, "/profiler/Tc_process", "cumulative process computation time") + CALL creatd(fidres, 0, dims, "/profiler/Tc_adv_field", "cumulative adv. fields computation time") + CALL creatd(fidres, 0, dims, "/profiler/Tc_ghost", "cumulative communication time") + CALL creatd(fidres, 0, dims, "/profiler/Tc_clos", "cumulative closure computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_checkfield", "cumulative checkfield computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_diag", "cumulative sym computation time") - CALL creatd(fidres, 0, dims, "/profiler/Tc_process", "cumulative process computation time") CALL creatd(fidres, 0, dims, "/profiler/Tc_step", "cumulative total step computation time") CALL creatd(fidres, 0, dims, "/profiler/time", "current simulation time") ! Grid info CALL creatg(fidres, "/data/grid", "Grid data") CALL putarr(fidres, "/data/grid/coordkx", kxarray_full, "kx*rho_s0", ionode=0) CALL putarr(fidres, "/data/grid/coordky", kyarray_full, "ky*rho_s0", ionode=0) CALL putarr(fidres, "/data/grid/coordz", zarray_full, "z/R", ionode=0) CALL putarr(fidres, "/data/grid/coordp_e" , parray_e_full, "p_e", ionode=0) CALL putarr(fidres, "/data/grid/coordj_e" , jarray_e_full, "j_e", ionode=0) CALL putarr(fidres, "/data/grid/coordp_i" , parray_i_full, "p_i", ionode=0) CALL putarr(fidres, "/data/grid/coordj_i" , jarray_i_full, "j_i", ionode=0) ! Metric info CALL creatg(fidres, "/data/metric", "Metric data") CALL putarrnd(fidres, "/data/metric/gxx", gxx(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gxy", gxy(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gxz", gxz(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gyy", gyy(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gyz", gyz(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gzz", gzz(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/hatR", hatR(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/hatZ", hatZ(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/hatB", hatB(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/hatB_NL", hatB_NL(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gradxB", gradxB(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gradyB", gradyB(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gradzB", gradzB(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/Jacobian", Jacobian(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/gradz_coeff", gradz_coeff(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/Ckxky", Ckxky(ikys:ikye,ikxs:ikxe,izs:ize,0:1), (/1, 1, 3/)) CALL putarrnd(fidres, "/data/metric/kernel_i", kernel_i(ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize,0:1), (/ 1, 2, 4/)) ! var0d group (gyro transport) IF (nsave_0d .GT. 0) THEN CALL creatg(fidres, "/data/var0d", "0d profiles") CALL creatd(fidres, rank, dims, "/data/var0d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var0d/cstep", "iteration number") IF (write_gamma) THEN CALL creatd(fidres, rank, dims, "/data/var0d/gflux_ri", "Radial gyro ion transport") CALL creatd(fidres, rank, dims, "/data/var0d/pflux_ri", "Radial part ion transport") IF(KIN_E) THEN CALL creatd(fidres, rank, dims, "/data/var0d/gflux_re", "Radial gyro electron transport") CALL creatd(fidres, rank, dims, "/data/var0d/pflux_re", "Radial part electron transport") ENDIF ENDIF IF (write_hf) THEN CALL creatd(fidres, rank, dims, "/data/var0d/hflux_xi", "Radial part ion heat flux") IF(KIN_E) THEN CALL creatd(fidres, rank, dims, "/data/var0d/hflux_xe", "Radial part electron heat flux") ENDIF ENDIF IF (cstep==0) THEN iframe0d=0 ENDIF CALL attach(fidres,"/data/var0d/" , "frames", iframe0d) END IF ! var2d group (??) IF (nsave_2d .GT. 0) THEN CALL creatg(fidres, "/data/var2d", "2d profiles") CALL creatd(fidres, rank, dims, "/data/var2d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var2d/cstep", "iteration number") IF (cstep==0) THEN iframe2d=0 ENDIF CALL attach(fidres,"/data/var2d/" , "frames", iframe2d) END IF ! var3d group (electro. pot., Ni00 moment) IF (nsave_3d .GT. 0) THEN CALL creatg(fidres, "/data/var3d", "3d profiles") CALL creatd(fidres, rank, dims, "/data/var3d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var3d/cstep", "iteration number") IF (write_phi) CALL creatg(fidres, "/data/var3d/phi", "phi") IF (write_phi) CALL creatg(fidres, "/data/var3d/psi", "psi") IF (write_Na00) THEN IF(KIN_E)& CALL creatg(fidres, "/data/var3d/Ne00", "Ne00") CALL creatg(fidres, "/data/var3d/Ni00", "Ni00") IF(KIN_E)& CALL creatg(fidres, "/data/var3d/Nepjz", "Nepjz") CALL creatg(fidres, "/data/var3d/Nipjz", "Nipjz") ENDIF IF (write_dens) THEN IF(KIN_E)& CALL creatg(fidres, "/data/var3d/dens_e", "dens_e") CALL creatg(fidres, "/data/var3d/dens_i", "dens_i") ENDIF IF (write_fvel) THEN IF(KIN_E) THEN CALL creatg(fidres, "/data/var3d/upar_e", "upar_e") CALL creatg(fidres, "/data/var3d/uper_e", "uper_e") ENDIF CALL creatg(fidres, "/data/var3d/upar_i", "upar_i") CALL creatg(fidres, "/data/var3d/uper_i", "uper_i") ENDIF IF (write_temp) THEN IF(KIN_E) THEN CALL creatg(fidres, "/data/var3d/Tper_e", "Tper_e") CALL creatg(fidres, "/data/var3d/Tpar_e", "Tpar_e") CALL creatg(fidres, "/data/var3d/temp_e", "temp_e") ENDIF CALL creatg(fidres, "/data/var3d/Tper_i", "Tper_i") CALL creatg(fidres, "/data/var3d/Tpar_i", "Tpar_i") CALL creatg(fidres, "/data/var3d/temp_i", "temp_i") ENDIF IF (cstep==0) THEN iframe3d=0 ENDIF CALL attach(fidres,"/data/var3d/" , "frames", iframe3d) END IF ! var5d group (moments) IF (nsave_5d .GT. 0) THEN CALL creatg(fidres, "/data/var5d", "5d profiles") CALL creatd(fidres, rank, dims, "/data/var5d/time", "Time t*c_s/R") CALL creatd(fidres, rank, dims, "/data/var5d/cstep", "iteration number") IF (write_Napj) THEN IF(KIN_E)& CALL creatg(fidres, "/data/var5d/moments_e", "moments_e") CALL creatg(fidres, "/data/var5d/moments_i", "moments_i") ENDIF IF (write_Sapj) THEN IF(KIN_E)& CALL creatg(fidres, "/data/var5d/Sepj", "Sepj") CALL creatg(fidres, "/data/var5d/Sipj", "Sipj") ENDIF IF (cstep==0) THEN iframe5d=0 END IF CALL attach(fidres,"/data/var5d/" , "frames", iframe5d) END IF ENDIF !_____________________________________________________________________________ ! 2. Periodic diagnostics ! IF (kstep .GE. 0) THEN ! 2.1 0d history arrays IF (nsave_0d .GT. 0) THEN IF ( MOD(cstep, nsave_0d) == 0 ) THEN CALL diagnose_0d END IF END IF ! 2.2 1d profiles ! empty in our case ! 2.3 2d profiles ! empty in our case ! 2.3 3d profiles IF (nsave_3d .GT. 0) THEN IF (MOD(cstep, nsave_3d) == 0) THEN CALL diagnose_3d ! Looks at the folder if the file check_phi exists and spits a snapshot ! of the current electrostatic potential in a basic text file CALL spit_snapshot_check ENDIF ENDIF ! 2.4 5d profiles IF (nsave_5d .GT. 0 .AND. cstep .GT. 0) THEN IF (MOD(cstep, nsave_5d) == 0) THEN CALL diagnose_5d END IF END IF !_____________________________________________________________________________ ! 3. Final diagnostics ELSEIF (kstep .EQ. -1) THEN CALL attach(fidres, "/data/input","cpu_time",finish-start) ! make a checkpoint at last timestep if not crashed IF(.NOT. crashed) THEN IF(my_id .EQ. 0) write(*,*) 'Saving last state' IF (nsave_5d .GT. 0) & CALL diagnose_5d ENDIF ! Close all diagnostic files CALL mpi_barrier(MPI_COMM_WORLD, ierr) CALL closef(fidres) END IF END SUBROUTINE diagnose_full !!-------------- Auxiliary routines -----------------!! SUBROUTINE diagnose_0d USE basic USE futils, ONLY: append, attach, getatt USE diagnostics_par USE prec_const USE processing USE model, ONLY: KIN_E IMPLICIT NONE ! Time measurement data CALL append(fidres, "/profiler/Tc_rhs", tc_rhs,ionode=0) CALL append(fidres, "/profiler/Tc_adv_field", tc_adv_field,ionode=0) CALL append(fidres, "/profiler/Tc_clos", tc_clos,ionode=0) CALL append(fidres, "/profiler/Tc_ghost", tc_ghost,ionode=0) CALL append(fidres, "/profiler/Tc_coll", tc_coll,ionode=0) CALL append(fidres, "/profiler/Tc_poisson", tc_poisson,ionode=0) CALL append(fidres, "/profiler/Tc_Sapj", tc_Sapj,ionode=0) CALL append(fidres, "/profiler/Tc_checkfield",tc_checkfield,ionode=0) CALL append(fidres, "/profiler/Tc_diag", tc_diag,ionode=0) CALL append(fidres, "/profiler/Tc_process", tc_process,ionode=0) CALL append(fidres, "/profiler/Tc_step", tc_step,ionode=0) CALL append(fidres, "/profiler/time", time,ionode=0) ! Processing data CALL append(fidres, "/data/var0d/time", time,ionode=0) CALL append(fidres, "/data/var0d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var0d/", "frames",iframe2d) iframe0d=iframe0d+1 CALL attach(fidres,"/data/var0d/" , "frames", iframe0d) ! Ion transport data IF (write_gamma) THEN CALL compute_radial_ion_transport CALL append(fidres, "/data/var0d/gflux_ri",gflux_ri,ionode=0) CALL append(fidres, "/data/var0d/pflux_ri",pflux_ri,ionode=0) IF(KIN_E) THEN CALL compute_radial_electron_transport CALL append(fidres, "/data/var0d/gflux_re",gflux_re,ionode=0) CALL append(fidres, "/data/var0d/pflux_re",pflux_re,ionode=0) ENDIF ENDIF IF (write_hf) THEN CALL compute_radial_ion_heatflux CALL append(fidres, "/data/var0d/hflux_xi",hflux_xi,ionode=0) IF(KIN_E) THEN CALL compute_radial_electron_heatflux CALL append(fidres, "/data/var0d/hflux_xe",hflux_xe,ionode=0) ENDIF ENDIF END SUBROUTINE diagnose_0d SUBROUTINE diagnose_3d USE basic USE futils, ONLY: append, getatt, attach, putarrnd, putarr USE fields USE array USE grid, ONLY: ikxs,ikxe, ikys,ikye, Nkx, Nky, local_nkx, ikx, iky, ips_e, ips_i USE time_integration USE diagnostics_par USE prec_const USE processing USE model, ONLY: KIN_E IMPLICIT NONE CALL append(fidres, "/data/var3d/time", time,ionode=0) CALL append(fidres, "/data/var3d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var3d/", "frames",iframe3d) iframe3d=iframe3d+1 CALL attach(fidres,"/data/var3d/" , "frames", iframe3d) IF (write_phi) CALL write_field3d_kykxz(phi (ikys:ikye,ikxs:ikxe,izs:ize), 'phi') IF (write_phi) CALL write_field3d_kykxz(psi (ikys:ikye,ikxs:ikxe,izs:ize), 'psi') IF (write_Na00) THEN IF(KIN_E)THEN IF (CONTAINS_ip0_e) & Ne00(ikys:ikye,ikxs:ikxe,izs:ize) = moments_e(ip0_e,ij0_e,ikys:ikye,ikxs:ikxe,izs:ize,updatetlevel) CALL write_field3d_kykxz(Ne00(ikys:ikye,ikxs:ikxe,izs:ize), 'Ne00') ENDIF IF (CONTAINS_ip0_i) & Ni00(ikys:ikye,ikxs:ikxe,izs:ize) = moments_i(ip0_i,ij0_i,ikys:ikye,ikxs:ikxe,izs:ize,updatetlevel) CALL write_field3d_kykxz(Ni00(ikys:ikye,ikxs:ikxe,izs:ize), 'Ni00') ! CALL compute_Napjz_spectrum ! IF(KIN_E) & ! CALL write_field3d_pjz_e(Nepjz(ips_e:ipe_e,ijs_e:ije_e,izs:ize), 'Nepjz') ! CALL write_field3d_pjz_i(Nipjz(ips_i:ipe_i,ijs_i:ije_i,izs:ize), 'Nipjz') ENDIF !! Fuid moments IF (write_dens .OR. write_fvel .OR. write_temp) & CALL compute_fluid_moments IF (write_dens) THEN IF(KIN_E)& CALL write_field3d_kykxz(dens_e(ikys:ikye,ikxs:ikxe,izs:ize), 'dens_e') CALL write_field3d_kykxz(dens_i(ikys:ikye,ikxs:ikxe,izs:ize), 'dens_i') ENDIF IF (write_fvel) THEN IF(KIN_E)& CALL write_field3d_kykxz(upar_e(ikys:ikye,ikxs:ikxe,izs:ize), 'upar_e') CALL write_field3d_kykxz(upar_i(ikys:ikye,ikxs:ikxe,izs:ize), 'upar_i') IF(KIN_E)& CALL write_field3d_kykxz(uper_e(ikys:ikye,ikxs:ikxe,izs:ize), 'uper_e') CALL write_field3d_kykxz(uper_i(ikys:ikye,ikxs:ikxe,izs:ize), 'uper_i') ENDIF IF (write_temp) THEN IF(KIN_E)& CALL write_field3d_kykxz(Tpar_e(ikys:ikye,ikxs:ikxe,izs:ize), 'Tpar_e') CALL write_field3d_kykxz(Tpar_i(ikys:ikye,ikxs:ikxe,izs:ize), 'Tpar_i') IF(KIN_E)& CALL write_field3d_kykxz(Tper_e(ikys:ikye,ikxs:ikxe,izs:ize), 'Tper_e') CALL write_field3d_kykxz(Tper_i(ikys:ikye,ikxs:ikxe,izs:ize), 'Tper_i') IF(KIN_E)& CALL write_field3d_kykxz(temp_e(ikys:ikye,ikxs:ikxe,izs:ize), 'temp_e') CALL write_field3d_kykxz(temp_i(ikys:ikye,ikxs:ikxe,izs:ize), 'temp_i') ENDIF CONTAINS SUBROUTINE write_field3d_kykxz(field, text) USE parallel, ONLY : gather_xyz IMPLICIT NONE COMPLEX(dp), DIMENSION(ikys:ikye,ikxs:ikxe, izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text COMPLEX(dp), DIMENSION(1:Nky,1:Nkx,1:Nz) :: field_full CHARACTER(256) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var3d", TRIM(text), iframe3d IF (num_procs .EQ. 1) THEN ! no data distribution CALL putarr(fidres, dset_name, field(ikys:ikye,ikxs:ikxe, izs:ize), ionode=0) ELSEIF(GATHERV_OUTPUT) THEN ! output using one node (gatherv) CALL gather_xyz(field(ikys:ikye,1:Nkx,izs:ize),field_full(1:Nky,1:Nkx,1:Nz)) CALL putarr(fidres, dset_name, field_full(1:Nky,1:Nkx,1:Nz), ionode=0) ELSE ! output using putarrnd (very slow on marconi) CALL putarrnd(fidres, dset_name, field(ikys:ikye,ikxs:ikxe, izs:ize), (/1, 1, 3/)) ENDIF CALL attach(fidres, dset_name, "time", time) END SUBROUTINE write_field3d_kykxz SUBROUTINE write_field3d_pjz_i(field, text) IMPLICIT NONE REAL(dp), DIMENSION(ips_i:ipe_i,ijs_i:ije_i,izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var3d", TRIM(text), iframe3d IF (num_procs .EQ. 1) THEN ! no data distribution CALL putarr(fidres, dset_name, field(ips_i:ipe_i,ijs_i:ije_i,izs:ize), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ips_i:ipe_i,ijs_i:ije_i,izs:ize), (/1, 0, 3/)) ENDIF CALL attach(fidres, dset_name, "time", time) END SUBROUTINE write_field3d_pjz_i SUBROUTINE write_field3d_pjz_e(field, text) IMPLICIT NONE REAL(dp), DIMENSION(ips_e:ipe_e,ijs_e:ije_e,izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var3d", TRIM(text), iframe3d IF (num_procs .EQ. 1) THEN ! no data distribution CALL putarr(fidres, dset_name, field(ips_e:ipe_e,ijs_e:ije_e,izs:ize), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ips_e:ipe_e,ijs_e:ije_e,izs:ize), (/1, 0, 3/)) ENDIF CALL attach(fidres, dset_name, "time", time) END SUBROUTINE write_field3d_pjz_e END SUBROUTINE diagnose_3d SUBROUTINE diagnose_5d USE basic USE futils, ONLY: append, getatt, attach, putarrnd, putarr USE fields USE array!, ONLY: Sepj, Sipj USE grid, ONLY: ips_e,ipe_e, ips_i, ipe_i, & ijs_e,ije_e, ijs_i, ije_i, & Np_i, Nj_i, Np_e, Nj_e, Nky, Nkx, Nz, & ikxs,ikxe,ikys,ikye,izs,ize USE time_integration USE diagnostics_par USE prec_const USE model, ONLY: KIN_E IMPLICIT NONE CALL append(fidres, "/data/var5d/time", time,ionode=0) CALL append(fidres, "/data/var5d/cstep", real(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var5d/", "frames",iframe5d) iframe5d=iframe5d+1 CALL attach(fidres,"/data/var5d/" , "frames", iframe5d) IF (write_Napj) THEN IF(KIN_E)& CALL write_field5d_e(moments_e(ips_e:ipe_e,ijs_e:ije_e,ikys:ikye,ikxs:ikxe,izs:ize,updatetlevel), 'moments_e') CALL write_field5d_i(moments_i(ips_i:ipe_i,ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize,updatetlevel), 'moments_i') ENDIF IF (write_Sapj) THEN IF(KIN_E)& CALL write_field5d_e(Sepj(ips_e:ipe_e,ijs_e:ije_e,ikys:ikye,ikxs:ikxe,izs:ize), 'Sepj') CALL write_field5d_i(Sipj(ips_i:ipe_i,ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize), 'Sipj') ENDIF CONTAINS SUBROUTINE write_field5d_e(field, text) USE futils, ONLY: attach, putarr, putarrnd USE parallel, ONLY: gather_pjxyz_e USE grid, ONLY: ips_e,ipe_e, ijs_e,ije_e, ikxs,ikxe, ikys,ikye, izs,ize USE prec_const IMPLICIT NONE COMPLEX(dp), DIMENSION(ips_e:ipe_e,ijs_e:ije_e,ikys:ikye,ikxs:ikxe,izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text COMPLEX(dp), DIMENSION(1:Np_e,1:Nj_e,1:Nky,1:Nkx,1:Nz) :: field_full CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var5d", TRIM(text), iframe5d IF (num_procs .EQ. 1) THEN CALL putarr(fidres, dset_name, field(ips_e:ipe_e,ijs_e:ije_e,ikys:ikye,ikxs:ikxe,izs:ize), ionode=0) ELSEIF(GATHERV_OUTPUT) THEN ! output using one node (gatherv) CALL gather_pjxyz_e(field(ips_e:ipe_e,ijs_e:ije_e,ikys:ikye,ikxs:ikxe,izs:ize),& field_full(1:Np_e,1:Nj_e,1:Nky,1:Nkx,1:Nz)) CALL putarr(fidres, dset_name, field_full(1:Np_i,1:Nj_i,1:Nky,1:Nkx,1:Nz), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ips_e:ipe_e,ijs_e:ije_e,ikys:ikye,ikxs:ikxe,izs:ize), (/1,3,5/)) ENDIF CALL attach(fidres, dset_name, 'cstep', cstep) CALL attach(fidres, dset_name, 'time', time) CALL attach(fidres, dset_name, 'jobnum', jobnum) CALL attach(fidres, dset_name, 'dt', dt) CALL attach(fidres, dset_name, 'iframe2d', iframe2d) CALL attach(fidres, dset_name, 'iframe5d', iframe5d) END SUBROUTINE write_field5d_e SUBROUTINE write_field5d_i(field, text) USE futils, ONLY: attach, putarr, putarrnd USE parallel, ONLY: gather_pjxyz_i USE grid, ONLY: ips_i,ipe_i, ijs_i,ije_i, ikxs,ikxe, ikys,ikye, izs,ize USE prec_const IMPLICIT NONE COMPLEX(dp), DIMENSION(ips_i:ipe_i,ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize), INTENT(IN) :: field CHARACTER(*), INTENT(IN) :: text COMPLEX(dp), DIMENSION(1:Np_i,1:Nj_i,1:Nky,1:Nkx,1:Nz) :: field_full CHARACTER(LEN=50) :: dset_name WRITE(dset_name, "(A, '/', A, '/', i6.6)") "/data/var5d", TRIM(text), iframe5d IF (num_procs .EQ. 1) THEN CALL putarr(fidres, dset_name, field(ips_i:ipe_i,ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize), ionode=0) ELSEIF(GATHERV_OUTPUT) THEN ! output using one node (gatherv) CALL gather_pjxyz_i(field(ips_i:ipe_i,ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize),& field_full(1:Np_i,1:Nj_i,1:Nky,1:Nkx,1:Nz)) CALL putarr(fidres, dset_name, field_full(1:Np_i,1:Nj_i,1:Nky,1:Nkx,1:Nz), ionode=0) ELSE CALL putarrnd(fidres, dset_name, field(ips_i:ipe_i,ijs_i:ije_i,ikys:ikye,ikxs:ikxe,izs:ize), (/1,3,5/)) ENDIF CALL attach(fidres, dset_name, 'cstep', cstep) CALL attach(fidres, dset_name, 'time', time) CALL attach(fidres, dset_name, 'jobnum', jobnum) CALL attach(fidres, dset_name, 'dt', dt) CALL attach(fidres, dset_name, 'iframe2d', iframe2d) CALL attach(fidres, dset_name, 'iframe5d', iframe5d) END SUBROUTINE write_field5d_i END SUBROUTINE diagnose_5d SUBROUTINE spit_snapshot_check USE fields, ONLY: phi USE grid, ONLY: ikxs,ikxe,Nkx,ikys,ikye,Nky,izs,ize,Nz USE parallel, ONLY: gather_xyz USE basic IMPLICIT NONE LOGICAL :: file_exist INTEGER :: fid_check, ikx, iky, iz CHARACTER(256) :: check_filename COMPLEX(dp), DIMENSION(1:Nky,1:Nkx,1:Nz) :: field_to_check !! Spit a snapshot of PHI if requested (triggered by creating a file named "check_phi") INQUIRE(file='check_phi', exist=file_exist) IF( file_exist ) THEN IF(my_id.EQ. 0) WRITE(*,*) 'Check file found -> gather phi..' CALL gather_xyz(phi(ikys:ikye,ikxs:ikxe,izs:ize), field_to_check) IF(my_id.EQ. 0) THEN WRITE(check_filename,'(a16)') 'check_phi.out' OPEN(fid_check, file=check_filename, form='formatted') WRITE(*,*) 'Check file found -> output phi ..' WRITE(fid_check,*) Nky, Nkx, Nz DO iky = 1,Nky; DO ikx = 1, Nkx; DO iz = 1,Nz WRITE(fid_check,*) real(field_to_check(iky,ikx,iz)), ',' , imag(field_to_check(iky,ikx,iz)) ENDDO; ENDDO; ENDDO CLOSE(fid_check) WRITE(*,*) 'Check file found -> done.' ! delete the check_phi flagfile OPEN(fid_check, file='check_phi') CLOSE(fid_check, status='delete') ENDIF ENDIF END SUBROUTINE spit_snapshot_check