diff --git a/src/CLA_mod.F90 b/src/CLA_mod.F90 index 0489ed96887c0ca8263b68d9a73225a6d4ea4e13..e0bd0fe1a6601d82816b9da671e624aefc2c9e42 100644 --- a/src/CLA_mod.F90 +++ b/src/CLA_mod.F90 @@ -35,7 +35,7 @@ CONTAINS REAL(xp), DIMENSION(Jmax+2,Jmax+2) :: LL, iLL ! Laguerre matrix to invert (+1 dim for j=0 and +1 dim for coeff J+1) INTEGER :: i,n ! Hermite - HH = 0._dp + HH = 0._xp DO i = 1,Pmax+3 n = i-1 !poly. degree HH(1:i,i) = get_hermite_coeffs(n) @@ -43,7 +43,7 @@ CONTAINS CALL inverse_triangular(Pmax+3,HH,iHH) ! Laguerre - LL = 0._dp + LL = 0._xp DO i = 1,Jmax+2 n = i-1 !poly. degree LL(1:i,i) = get_laguerre_coeffs(n) diff --git a/src/basic_mod.F90 b/src/basic_mod.F90 index 6010c59d104a98faa8f3b4fbd0e211680f771339..a6cf8a8b33c70e5e68a62031def3a1093680b5bd 100644 --- a/src/basic_mod.F90 +++ b/src/basic_mod.F90 @@ -222,20 +222,20 @@ CONTAINS 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 + hours = NINT((time/3600./24. - days) * 24) + mins = NINT((time/3600. - days*24. - hours) * 60) + secs = NINT((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 + mins = NINT((time/3600. - hours) * 60) + secs = NINT((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 + secs = NINT((time/60. - mins) * 60) IF (my_id .EQ. 0) WRITE(*,*) 'CPU Time = ', mins, '[min]', secs, '[s]' IF (my_id .EQ. 0) WRITE(*,*) '(',time,'[s])' @@ -325,7 +325,7 @@ CONTAINS COMPLEX(xp), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1 ALLOCATE(a(is1:ie1)) - a=CMPLX(0.0_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc1 SUBROUTINE allocate_array_dc2(a,is1,ie1,is2,ie2) @@ -333,7 +333,7 @@ CONTAINS COMPLEX(xp), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2 ALLOCATE(a(is1:ie1,is2:ie2)) - a=CMPLX(0.0_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc2 SUBROUTINE allocate_array_dc3(a,is1,ie1,is2,ie2,is3,ie3) @@ -341,7 +341,7 @@ CONTAINS COMPLEX(xp), 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_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc3 SUBROUTINE allocate_array_dc4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4) @@ -349,7 +349,7 @@ CONTAINS COMPLEX(xp), 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_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc4 SUBROUTINE allocate_array_dc5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5) @@ -357,7 +357,7 @@ CONTAINS COMPLEX(xp), 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_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc5 SUBROUTINE allocate_array_dc6(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6) @@ -365,7 +365,7 @@ CONTAINS COMPLEX(xp), 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_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc6 SUBROUTINE allocate_array_dc7(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6,is7,ie7) @@ -373,7 +373,7 @@ CONTAINS COMPLEX(xp), DIMENSION(:,:,:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5,is6,ie6,is7,ie7 ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5,is6:ie6,is7:ie7)) - a=CMPLX(0.0_xp,0.0_xp) + a=CMPLX(0.,0.,xp) END SUBROUTINE allocate_array_dc7 !======================================== @@ -409,14 +409,6 @@ CONTAINS a=0 END SUBROUTINE allocate_array_i4 - SUBROUTINE allocate_array_i5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5) - IMPLICIT NONE - INTEGER, 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) @@ -451,12 +443,4 @@ CONTAINS 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/collision_mod.F90 b/src/collision_mod.F90 index ef4e0d78ae2abedf9aa7757d71c83f399f6c46ac..8af27e16cc43adbf87cf3df7d85d82fbe362454c 100644 --- a/src/collision_mod.F90 +++ b/src/collision_mod.F90 @@ -186,10 +186,10 @@ CONTAINS !** Assembling collison operator ** IF( (p_xp .EQ. 0._xp) .AND. (j_xp .EQ. 0._xp)) THEN !Ca00 Tmp = tau(ia)**2 * kp2_xp**2*(& - 67_xp/120_xp *moments(ia,ip0,ij0,iky,ikx,izi,updatetlevel)& - +67_xp*SQRT2/240_xp*moments(ia,ip2,ij0,iky,ikx,izi,updatetlevel)& - -67_xp/240_xp *moments(ia,ip0,ij1,iky,ikx,izi,updatetlevel)& - -3_xp/10_xp *q_tau(ia)*phi(iky,ikx,izi)) + 67._xp/120._xp *moments(ia,ip0,ij0,iky,ikx,izi,updatetlevel)& + +67._xp*SQRT2/240._xp*moments(ia,ip2,ij0,iky,ikx,izi,updatetlevel)& + -67._xp/240._xp *moments(ia,ip0,ij1,iky,ikx,izi,updatetlevel)& + -3._xp/10._xp *q_tau(ia)*phi(iky,ikx,izi)) ELSEIF( (p_xp .EQ. 2._xp) .AND. (j_xp .EQ. 0._xp)) THEN ! Ca20 Tmp = tau(ia) * kp2_xp*(& -SQRT2*twothird*moments(ia,ip0,ij0,iky,ikx,izi,updatetlevel)& diff --git a/src/cosolver_interface_mod.F90 b/src/cosolver_interface_mod.F90 index 268058e90d12a0813296d6b3213d4397a0d98c78..3c47527616246c730597461533b69c6f946cdb5c 100644 --- a/src/cosolver_interface_mod.F90 +++ b/src/cosolver_interface_mod.F90 @@ -135,7 +135,7 @@ CONTAINS REAL(xp), DIMENSION(:,:,:,:), ALLOCATABLE :: Caa__kp ! To store the coeff that will be used along kperp REAL(xp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: CabF_kp,CabT_kp ! '' REAL(xp), DIMENSION(:), ALLOCATABLE :: kp_grid_mat ! kperp grid of the matrices - REAL(xp), DIMENSION(2) :: dims + INTEGER, DIMENSION(2) :: dims ! Indices for row and columns of the COSOlver matrix (4D compressed 2D matrices) INTEGER :: irow_sub, irow_full, icol_sub, icol_full INTEGER :: fid ! file indexation diff --git a/src/diagnostics_mod.F90 b/src/diagnostics_mod.F90 index 8d4f9879281a950a165bc851dd950a7c8a51e0a1..c2afdb028fe96a5637334a3a1b6b14f4b0600c75 100644 --- a/src/diagnostics_mod.F90 +++ b/src/diagnostics_mod.F90 @@ -566,9 +566,8 @@ CONTAINS USE grid, ONLY:total_np, total_nj, total_nky, total_nkx, total_nz, & local_np, local_nj, local_nky, local_nkx, local_nz, & ngp, ngj, ngz, total_na - USE prec_const, ONLY: xp,dp + USE prec_const, ONLY: xp, dp IMPLICIT NONE - CALL append(fidres, "/data/var5d/time", REAL(time,dp),ionode=0) CALL append(fidres, "/data/var5d/cstep", REAL(cstep,dp),ionode=0) CALL getatt(fidres, "/data/var5d/", "frames",iframe5d) @@ -632,6 +631,7 @@ CONTAINS CALL gather_xyz(phi(:,:,(1+Ngz/2):(local_nz+Ngz/2)), field_to_check,local_nky,total_nky,total_nkx,local_nz,total_nz) IF(my_id.EQ. 0) THEN WRITE(check_filename,'(a16)') 'check_phi.out' + fid_check = 0 OPEN(fid_check, file=check_filename, form='formatted') WRITE(*,*) 'Check file found -> output phi ..' WRITE(fid_check,*) total_nky, total_nkx, total_nz diff --git a/src/fourier_mod.F90 b/src/fourier_mod.F90 index 1f7951e3b6c398955fd53dec4414d5683d6bf0a6..f50df01061986d6f006991db6591917304c9692c 100644 --- a/src/fourier_mod.F90 +++ b/src/fourier_mod.F90 @@ -19,12 +19,10 @@ MODULE fourier PUBLIC :: init_grid_distr_and_plans, poisson_bracket_and_sum, finalize_plans, apply_inv_ExB_NL_factor !! Module variables - CHARACTER(2) :: FFT_ALGO ! use of 2D or 1D routines !! 2D fft specific variables (C interface) type(C_PTR) :: cdatar_f, cdatar_g, cdatar_c type(C_PTR) :: cdatac_f, cdatac_g, cdatac_c type(C_PTR) , PUBLIC :: planf, planb - integer(C_INTPTR_T) :: i, ix, iy integer(C_INTPTR_T), PUBLIC :: alloc_local_1, alloc_local_2 integer(C_INTPTR_T) :: NX_, NY_, NY_halved, local_nky_, local_nx_ real (c_xp_r), pointer, PUBLIC :: real_data_f(:,:), real_data_g(:,:), bracket_sum_r(:,:) @@ -344,7 +342,7 @@ END SUBROUTINE fft1D_plans COMPLEX(xp), DIMENSION(NX_,local_nky_), INTENT(IN) :: ExB_NL_factor ! local variables COMPLEX(xp), DIMENSION(NX_,local_nky_) :: tmp_kxky, tmp_xky - INTEGER :: ix,ikx,iky + integer(C_INTPTR_T) :: ix,ikx,iky ! Fill the buffer DO iky = 1,local_nky_ DO ikx = 1,NX_ @@ -377,7 +375,7 @@ END SUBROUTINE fft1D_plans ! local variables REAL(xp), DIMENSION(2*NY_halved,local_nx_) :: tmp_yx_1, tmp_yx_2 COMPLEX(xp), DIMENSION(NY_halved+1,local_nx_) :: tmp_kyx - INTEGER :: ix, iy, iky + integer(C_INTPTR_T) :: ix, iy, iky ! Fill buffer DO ix = 1,local_nx_ DO iy = 1,2*NY_halved diff --git a/src/grid_mod.F90 b/src/grid_mod.F90 index c2ef3f0e84342f35f7b795b807d700f394081921..a17d89dfb832cb010882e1371750635f89212735 100644 --- a/src/grid_mod.F90 +++ b/src/grid_mod.F90 @@ -77,7 +77,8 @@ MODULE grid integer(C_INTPTR_T), PUBLIC,PROTECTED :: local_nx_ptr, local_nky_ptr integer(C_INTPTR_T), PUBLIC,PROTECTED :: local_nx_ptr_offset, local_nky_ptr_offset ! Grid spacing and limits - REAL(xp), PUBLIC, PROTECTED :: deltap, deltaz, inv_deltaz, inv_dkx + INTEGER , PUBLIC, PROTECTED :: deltap + REAL(xp), PUBLIC, PROTECTED :: deltaz, inv_deltaz, inv_dkx REAL(xp), PUBLIC, PROTECTED :: deltakx, deltaky, deltax, kx_max, ky_max, kx_min, ky_min!, kp_max INTEGER , PUBLIC, PROTECTED :: local_pmin, local_pmax INTEGER , PUBLIC, PROTECTED :: local_jmin, local_jmax @@ -209,10 +210,10 @@ CONTAINS Nky = Ny/2+1 ! Defined only on positive kx since fields are real total_nky = Nky Ngy = 0 ! no ghosts cells in ky - ikys = local_nky_ptr_offset + 1 - ikye = ikys + local_nky_ptr - 1 + ikys = INT(local_nky_ptr_offset + 1) + ikye = INT(ikys + local_nky_ptr - 1) local_nky = ikye - ikys + 1 - local_nky_offset = local_nky_ptr_offset + local_nky_offset = INT(local_nky_ptr_offset) ALLOCATE(kyarray_full(Nky)) ALLOCATE(kyarray(local_nky)) ALLOCATE(ikyarray(Nky)) @@ -230,8 +231,8 @@ CONTAINS ALLOCATE(kxarray(local_nky,local_Nkx)) ALLOCATE(AA_x(local_nkx)) !!---------------- RADIAL X GRID (only for Fourier routines) - local_nx = local_nx_ptr - local_nx_offset = local_nx_ptr_offset + local_nx = INT(local_nx_ptr) + local_nx_offset = INT(local_nx_ptr_offset) ALLOCATE(xarray(Nx)) !!---------------- PARALLEL Z GRID (parallelized) total_nz = Nz @@ -563,7 +564,7 @@ CONTAINS USE prec_const, ONLY: xp, pi IMPLICIT NONE INTEGER :: ix - REAL :: L_ + REAL(xp):: L_ L_ = 2._xp*pi/deltakx deltax = L_/REAL(Nx,xp) ! full xgrid diff --git a/src/initial_mod.F90 b/src/initial_mod.F90 index 0a0c5c700102c90f3a3fdbedfafcca9df5a74402..c4ab7b9a6e183e7f12ec3c192471fed4b9246600 100644 --- a/src/initial_mod.F90 +++ b/src/initial_mod.F90 @@ -545,12 +545,13 @@ CONTAINS USE prec_const, ONLY: xp, imagu USE model, ONLY: LINEARITY IMPLICIT NONE - REAL(xp), DIMENSION(186,94) :: ricci_mat_real, ricci_mat_imag + REAL(xp), DIMENSION(:,:), ALLOCATABLE :: ricci_mat_real, ricci_mat_imag REAL(xp) :: scaling INTEGER :: ia,ip,ij,ikx,iky,iz, LPFx, LPFy CHARACTER(256) :: filename - ! open data file + ! load picture from data file + ALLOCATE(ricci_mat_real(186,94),ricci_mat_imag(186,94)) ricci_mat_real = 0; ricci_mat_imag = 0 filename = TRIM(maindir) // '/Gallery/fourier_ricci_real.txt' OPEN(unit = 1 , file = filename) @@ -609,6 +610,7 @@ CONTAINS moments(:,:,:,iky,ikx,:,:) = 0._xp ENDDO ENDDO + DEALLOCATE(ricci_mat_real,ricci_mat_imag) END SUBROUTINE init_ricci !******************************************************************************! diff --git a/src/lag_interp_mod.F90 b/src/lag_interp_mod.F90 index 39cea31f42bf310914a047883608c5e5679f9ca9..d8cfa8d49c468e6d913288fee6a12507c2fa77c2 100644 --- a/src/lag_interp_mod.F90 +++ b/src/lag_interp_mod.F90 @@ -89,11 +89,11 @@ CONTAINS !> Third order lagrange interpolation for complex arrays SUBROUTINE lag3interp_complex(y_in,x_in,n_in,y_out,x_out,n_out) - INTEGER, INTENT(IN) :: n_in,n_out - COMPLEX, DIMENSION(n_in), INTENT(IN) :: y_in - REAL(xp), DIMENSION(n_in), INTENT(IN) :: x_in - COMPLEX, DIMENSION(n_out), INTENT(OUT) :: y_out - REAL(xp), DIMENSION(n_out), INTENT(IN) :: x_out + INTEGER, INTENT(IN) :: n_in,n_out + COMPLEX(xp), DIMENSION(n_in), INTENT(IN) :: y_in + REAL(xp), DIMENSION(n_in), INTENT(IN) :: x_in + COMPLEX(xp), DIMENSION(n_out), INTENT(OUT):: y_out + REAL(xp), DIMENSION(n_out), INTENT(IN) :: x_out REAL(xp) :: x,aintm,aint0,aint1,aint2,xm,x0,x1,x2 INTEGER :: j,jm,j0,j1,j2 diff --git a/src/miller_mod.F90 b/src/miller_mod.F90 index ad06e9448a8ef77ca711b06859bdb292d3f8a307..5f8528439cf351faff7586a7cce0a089272b0179 100644 --- a/src/miller_mod.F90 +++ b/src/miller_mod.F90 @@ -21,7 +21,6 @@ MODULE miller real(xp) :: rho, kappa, delta, s_kappa, s_delta, drR, drZ, zeta, s_zeta real(xp) :: thetaShift real(xp) :: thetak, thetad - INTEGER :: ierr CONTAINS !>Set defaults for miller parameters diff --git a/src/prec_const_mod.F90 b/src/prec_const_mod.F90 index f8fedacda57a3c3e1006e46c87f0a48140bad660..bc51494f0e2a2dbb05e592e7f7634a8e96b0eafb 100644 --- a/src/prec_const_mod.F90 +++ b/src/prec_const_mod.F90 @@ -7,17 +7,8 @@ MODULE prec_const stdout=>output_unit, & stderr=>error_unit use, intrinsic :: iso_c_binding - - ! Define single and double precision - INTEGER, PARAMETER :: sp = REAL32 !Single precision - INTEGER, PARAMETER :: dp = REAL64 !Double precision - INTEGER, private :: dp_r, dp_p !Range and Aprecision of doubles - INTEGER, private :: sp_r, sp_p !Range and precision of singles - INTEGER, private :: MPI_SP !Single precision for MPI - INTEGER, private :: MPI_DP !Double precision in MPI - INTEGER, private :: MPI_SUM_DP !Sum reduction operation for DP datatype - INTEGER, private :: MPI_MAX_DP !Max reduction operation for DP datatype - INTEGER, private :: MPI_MIN_DP !Min reduction operation for DP datatype + INTEGER, PARAMETER :: sp = REAL32 + INTEGER, PARAMETER :: dp = REAL64 ! Define a generic precision parameter for the entire program #ifdef SINGLE_PRECISION @@ -36,10 +27,6 @@ MODULE prec_const ! Auxiliary variables (unused) INTEGER, private :: xp_r, xp_p !Range and precision of single INTEGER, private :: MPI_XP !Double precision in MPI - INTEGER, private :: MPI_SUM_XP !Sum reduction operation for xp datatype - INTEGER, private :: MPI_MAX_XP !Max reduction operation for xp datatype - INTEGER, private :: MPI_MIN_XP !Min reduction operation for xp datatype - ! Some useful constants, to avoid recomputing them too often REAL(xp), PARAMETER :: PI=3.141592653589793238462643383279502884197_xp @@ -70,14 +57,7 @@ MODULE prec_const IMPLICIT NONE integer :: ierr,me - ! REAL(sp) :: a = 1_sp - ! REAL(dp) :: b = 1_dp - !Get range and precision of ISO FORTRAN sizes - ! sp_r = range(a) - ! sp_p = precision(a) - ! dp_r = range(b) - ! dp_p = precision(b) - + !Get range and precision of ISO FORTRAN sizes REAL(xp) :: c = 1._xp xp_r = range(c) xp_p = precision(c) @@ -85,8 +65,6 @@ MODULE prec_const CALL mpi_comm_rank(MPI_COMM_WORLD,me,ierr) !Create MPI datatypes that support the specific size - ! CALL MPI_Type_create_f90_real(sp_p,sp_r,MPI_sp,ierr) - ! CALL MPI_Type_create_f90_real(dp_p,dp_r,MPI_xp,ierr) CALL MPI_Type_create_f90_real(xp_p,xp_r,MPI_xp,ierr) END SUBROUTINE INIT_PREC_CONST diff --git a/src/processing_mod.F90 b/src/processing_mod.F90 index df58434ae692ef69ecbb95226d1894fd437a09d9..028bb44a3468cddccf05e2c50ae944672d5bbf82 100644 --- a/src/processing_mod.F90 +++ b/src/processing_mod.F90 @@ -246,8 +246,8 @@ CONTAINS ENDDO ENDIF ELSE - gflux_x(ia) = gflux_local - pflux_x(ia) = pflux_local + gflux_x(ia) = REAL(gflux_local,xp) + pflux_x(ia) = REAL(pflux_local,xp) ENDIF ENDDO END SUBROUTINE compute_radial_transport @@ -332,7 +332,7 @@ CONTAINS ENDDO ENDIF ELSE - hflux_x(ia) = hflux_local + hflux_x(ia) = REAL(hflux_local,xp) ENDIF ENDDO END SUBROUTINE compute_radial_heatflux @@ -355,8 +355,8 @@ CONTAINS DO ij = 1,local_nj DO ip = 1,local_np local_sum(ip,ij,iz) = local_sum(ip,ij,iz) + & - (moments(ia,ip+Ngp/2,ij+Ngj/2,iky,ikx,iz+Ngz/2,updatetlevel) & - * CONJG(moments(ia,ip+Ngp/2,ij+Ngj/2,iky,ikx,iz+Ngz/2,updatetlevel))) + REAL(moments(ia,ip+Ngp/2,ij+Ngj/2,iky,ikx,iz+Ngz/2,updatetlevel) & + * CONJG(moments(ia,ip+Ngp/2,ij+Ngj/2,iky,ikx,iz+Ngz/2,updatetlevel)),xp) ENDDO ENDDO ENDDO diff --git a/src/restarts_mod.F90 b/src/restarts_mod.F90 index 7621c74db78467f05e208dc84099cb3813df167b..88f561f9c7d32fca188af440197bbeda2c581f2d 100644 --- a/src/restarts_mod.F90 +++ b/src/restarts_mod.F90 @@ -9,7 +9,7 @@ USE grid, ONLY: local_Na,local_Na_offset,local_np,local_np_offset,& kyarray_full,kxarray_full,zarray, zarray_full, local_zmin, local_zmax ! for z interp USE fields, ONLY: moments, phi, psi !USE time_integration -USE prec_const, ONLY : xp,dp,sp,PI +USE prec_const, ONLY : xp,PI USE MPI, ONLY: MPI_COMM_WORLD IMPLICIT NONE @@ -45,11 +45,11 @@ CONTAINS WRITE(rstfile,'(a,i2.2,a3)') 'outputs_',job2load,'.h5' CALL speak("Resume from "//rstfile) ! Open file - IF(xp .EQ. dp) THEN - CALL openf(rstfile, fidrst, mode='r', real_prec='d', mpicomm=comm0) - ELSE - CALL openf(rstfile, fidrst, mode='r', mpicomm=comm0) - ENDIF +#ifdef SINGLE_PRECISION + CALL openf(rstfile, fidrst, mode='r', mpicomm=comm0) +#else + CALL openf(rstfile, fidrst, mode='r', real_prec='d', mpicomm=comm0) +#endif ! Get the dimensions of the checkpoint moments CALL getatt(fidrst,"/data/input/model", "Na", Na_cp) CALL getatt(fidrst,"/data/input/grid" , "Np", Np_cp) diff --git a/src/species_mod.F90 b/src/species_mod.F90 index 70b5d908bd2abf09bc01d2f3e35f27b0b01e6e1a..d13a2142ee74fa26f9048dbc620ca56aa98894bf 100644 --- a/src/species_mod.F90 +++ b/src/species_mod.F90 @@ -29,7 +29,7 @@ MODULE species REAL(xp), ALLOCATABLE, DIMENSION(:),PUBLIC, PROTECTED :: q2_tau ! factor of the gammaD sum REAL(xp), ALLOCATABLE, DIMENSION(:),PUBLIC, PROTECTED :: q_o_sqrt_tau_sigma ! For psi field terms REAL(xp), ALLOCATABLE, DIMENSION(:),PUBLIC, PROTECTED :: sqrt_tau_o_sigma ! For Ampere eq - REAL(xp), PUBLIC, PROTECTED :: Ptot = 0._dp ! total pressure + REAL(xp), PUBLIC, PROTECTED :: Ptot = 0._xp ! total pressure !! Accessible routines PUBLIC :: species_readinputs, species_outputinputs CONTAINS @@ -84,7 +84,7 @@ CONTAINS ADIAB_I = .FALSE. END SELECT ENDDO - IF (.NOT. MHD_PD) Ptot = 0._dp + IF (.NOT. MHD_PD) Ptot = 0._xp !! Set collision frequency tensor IF (nu .EQ. 0) THEN nu_ab = 0 diff --git a/src/stepon.F90 b/src/stepon.F90 index ee5fd1da84dbf9c9c5ab0300e3970993bdd279b0..5715d106c7768af312f17cf01caa96c86070d384 100644 --- a/src/stepon.F90 +++ b/src/stepon.F90 @@ -8,7 +8,7 @@ SUBROUTINE stepon USE ghosts, ONLY: update_ghosts_moments, update_ghosts_EM use mpi, ONLY: MPI_COMM_WORLD USE time_integration, ONLY: ntimelevel - USE prec_const, ONLY: xp + USE prec_const, ONLY: xp, sp #ifdef TEST_SVD USE CLA, ONLY: test_svd,filter_sv_moments_ky_pj #endif @@ -114,14 +114,14 @@ CONTAINS USE model, ONLY: LINEARITY, FORCE_SYMMETRY IMPLICIT NONE LOGICAL :: checkf_ - REAL :: sum_ + REAL(sp):: sum_ ! filtering IF(LINEARITY .NE. 'linear') CALL anti_aliasing ! ensure 0 mode for 2/3 rule IF(FORCE_SYMMETRY) CALL enforce_symmetry ! Enforcing symmetry on kx = 0 (looks useless) mlend=.FALSE. IF(.NOT.nlend) THEN - sum_ = SUM(ABS(phi)) + sum_ = REAL(SUM(ABS(phi)),sp) checkf_ = (is_nan(sum_,'phi') .OR. is_inf(sum_,'phi')) mlend = (mlend .or. checkf_) CALL MPI_ALLREDUCE(mlend, nlend, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) diff --git a/src/time_integration_mod.F90 b/src/time_integration_mod.F90 index 0ed20e6e18c9b253154943a92a352266439d3080..e8cff1d4033fd0c52a1beb743023cc52fcd62021 100644 --- a/src/time_integration_mod.F90 +++ b/src/time_integration_mod.F90 @@ -35,7 +35,9 @@ MODULE time_integration integer, public, protected :: updatetlevel_rhs = 1 !< time level to be updated for rhs !!---- end - PUBLIC :: set_updatetlevel, time_integration_readinputs, time_integration_outputinputs + PUBLIC :: set_updatetlevel, time_integration_readinputs, time_integration_outputinputs, & + adaptive_time_scheme_setup, adaptive_set_error, adaptive_must_recompute_step, & + set_updatetlevel_rhs CONTAINS