diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 00000000..eaa83456 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,234 @@ +# CLAUDE.md +Claude Code Operating Rules for This Repository + +This file defines **hard constraints** and **preferred behaviors** for Claude +working in this repository. These rules exist to protect numerical correctness, +performance, and long-term maintainability of a high-order spectral element +codebase. + +Follow all rules below unless explicitly instructed otherwise by a human +maintainer. + +--- + +## 1. Project Purpose + +This project implements **high-order spectral element methods** for solving +systems of conservation laws (e.g., Euler, shallow water, Maxwell, MHD) on +structured and unstructured meshes. + +Primary goals: +- Numerical correctness and stability +- Conservation properties +- High performance on CPUs and GPUs +- MPI scalability + +Changes must NOT degrade: +- Accuracy order +- Stability properties +- Parallel scaling +- Memory behavior + +--- + +## 2. Fortran Standards & Toolchain + +### Language Standard +- Target: **Fortran 2008** +- Code must remain compatible with: + - gfortran ≥ 11 + - ifx + - nvfortran + - amdflang + +### Prohibited Language Features +Do NOT introduce: +- Coarrays +- Fortran 2018+ features +- Compiler-specific extensions +- Automatic polymorphism in performance-critical paths + +### Formatting & Conventions +- Free-form source +- `implicit none` required in all program units +- Explicit `intent(in|out|inout)` on all dummy arguments +- Lowercase keywords preferred +- Line length ≤ 100 characters + +--- + +## 3. Numerical & Algorithmic Constraints + +### Hard Rules +- Do NOT change the mathematical formulation without approval +- Do NOT change discretization order +- Do NOT change basis, quadrature, or nodal ordering +- Do NOT reorder floating-point reductions +- Do NOT alter time integration schemes + +### Floating-Point Behavior +- Bitwise reproducibility may be required +- Preserve operation ordering in loops +- Avoid algebraic “simplifications” unless mathematically justified + +### Array Semantics +- Do NOT replace explicit loops with array syntax unless equivalence is proven +- Avoid implicit temporaries + +--- + +## 4. Performance Rules (Critical) + +This is an HPC codebase. Performance regressions are unacceptable. + +### Memory +- Avoid temporary allocations in hot paths +- No automatic arrays in tight loops +- No hidden allocations via array slicing + +### Loops +- Preserve loop ordering for cache locality +- Do NOT replace DO loops with WHERE / FORALL +- Vectorization-friendly structure must be preserved + +### Abstraction +- Do NOT introduce runtime polymorphism in kernels +- Avoid excessive modularization inside hot loops + +--- + +## 5. Parallel Programming + +### MPI +- MPI calls must remain explicit +- Do NOT introduce blocking collectives inside time-stepping loops +- Do NOT change communicator usage +- Preserve rank-local data ownership + +### OpenMP / GPU +- Preserve OpenMP semantics +- Do NOT move data regions without explicit instruction +- GPU kernels must preserve memory access patterns +- No implicit host/device transfers + +--- + +## 6. Code Organization & APIs + +### File & Module Structure +- Do NOT rename modules +- Do NOT move files between directories +- Do NOT change public interfaces without approval +- Preserve module dependency order + +### Public APIs +- Public procedures are considered **stable** +- Backward compatibility is required unless stated otherwise + +--- + +## 7. Testing & Validation + +### Required +- All existing regression tests must pass +- Do NOT modify reference output files +- Numerical differences must be justified + +### New Code +- New features require: + - A test case + - Clear validation criteria +- MPI tests must work on ≥ 2 ranks + +--- + +## 8. Documentation & Comments + +### Preserve Scientific Meaning +- Do NOT remove comments describing: + - Equations + - Algorithms + - Numerical assumptions + +### New Routines +Must include: +- Mathematical description +- Variable meaning and units +- Expected input ranges + +--- + +## 9. Code Formatting + +All Fortran source must be formatted with [`fprettify`](https://pypi.org/project/fprettify/) using the project's `fprettify.config`. PRs are checked for formatting before any other tests run. + +To format all source files manually: + +```shell +fprettify './src/' --config-file ./fprettify.config --recursive --case 1 1 1 1 +fprettify './test/' --config-file ./fprettify.config --recursive --case 1 1 1 1 +fprettify './examples/' --config-file ./fprettify.config --recursive --case 1 1 1 1 +``` + +Alternatively, install the provided `pre-commit` hook to apply formatting automatically on each commit: + +```shell +pip install pre-commit fprettify +pre-commit install # run from repository root +``` + +When editing Fortran files, apply `fprettify` before committing. Do NOT manually reformat code by hand in ways that deviate from `fprettify` output. + +--- + +## 10. Prohibited Actions (Explicit) + +Do NOT: +- Rewrite code in another language +- Convert procedural code to OO Fortran +- Replace MPI with coarrays +- Introduce external dependencies +- “Modernize” syntax without benefit +- Delete legacy code without explanation + +--- + +## 11. Domain-Specific Assumptions + +- Grid indexing follows project conventions (do NOT reorder indices) +- Jacobians and metric terms are precomputed +- Flux routines assume nodal basis ordering +- Element-local operations must remain element-local +- Halo exchange patterns are fixed + +--- + +## 12. Preferred Behavior + +DO: +- Ask before changing algorithms +- Explain numerical and performance implications +- Provide minimal diffs +- Reference existing patterns in the codebase +- Flag any uncertainty explicitly + +DO NOT: +- Make large refactors unless requested +- Assume intent beyond the explicit request + +--- + +## 13. When in Doubt + +If a change could affect: +- Numerical accuracy +- Stability +- Performance +- Parallel behavior + +STOP and ask for clarification. + +--- + +End of CLAUDE.md + diff --git a/examples/linear_euler2d_planewave_propagation.f90 b/examples/linear_euler2d_planewave_propagation.f90 index a272976b..85769f19 100644 --- a/examples/linear_euler2d_planewave_propagation.f90 +++ b/examples/linear_euler2d_planewave_propagation.f90 @@ -107,6 +107,7 @@ pure function hbc2d_Prescribed_lineareuler2d_planewave(this,x,t) result(exts) exts(2) = u*shape ! u exts(3) = v*shape ! v exts(4) = p*shape ! pressure + if(.false.) exts(1) = exts(1)+t ! suppress unused-dummy-argument warning endfunction hbc2d_Prescribed_lineareuler2d_planewave diff --git a/examples/linear_euler2d_planewave_reflection.f90 b/examples/linear_euler2d_planewave_reflection.f90 index 20c3ef3c..508c81c7 100644 --- a/examples/linear_euler2d_planewave_reflection.f90 +++ b/examples/linear_euler2d_planewave_reflection.f90 @@ -122,6 +122,7 @@ pure function hbc2d_Prescribed_lineareuler2d_planewave(this,x,t) result(exts) exts(2) = u*(shi-shr) ! u exts(3) = v*(shi+shr) ! v exts(4) = p*(shi+shr) ! pressure + if(.false.) exts(1) = exts(1)+t ! suppress unused-dummy-argument warning endfunction hbc2d_Prescribed_lineareuler2d_planewave diff --git a/examples/linear_shallow_water2d_kelvinwaves.f90 b/examples/linear_shallow_water2d_kelvinwaves.f90 index c4985ec6..2cf74a23 100644 --- a/examples/linear_shallow_water2d_kelvinwaves.f90 +++ b/examples/linear_shallow_water2d_kelvinwaves.f90 @@ -38,13 +38,11 @@ program linear_shallow_water2d_kelvinwaves real(prec),parameter :: f0 = 10.0_prec ! reference coriolis parameter (1/s) real(prec),parameter :: Cd = 0.25_prec ! Linear drag coefficient (1/s) real(prec),parameter :: iointerval = 0.05 ! Write files 20 times per characteristic time scale - real(prec) :: r real(prec) :: e0,ef ! Initial and final entropy type(LinearShallowWater2D) :: modelobj ! Shallow water model type(Lagrange),target :: interp ! Interpolant type(Mesh2D),target :: mesh ! Mesh class type(SEMQuad),target :: geometry ! Geometry class - integer :: i,j,iel real(prec),parameter :: g = 1.0_prec ! Acceleration due to gravity real(prec),parameter :: H = 1.0_prec ! Uniform resting depth character(LEN=255) :: WORKSPACE diff --git a/examples/linear_shallow_water2d_nonormalflow.f90 b/examples/linear_shallow_water2d_nonormalflow.f90 index 1b98de72..c494d581 100644 --- a/examples/linear_shallow_water2d_nonormalflow.f90 +++ b/examples/linear_shallow_water2d_nonormalflow.f90 @@ -43,7 +43,6 @@ program linear_shallow_water2d_nonormalflow_model integer :: bcids(1:4) ! Boundary conditions for structured mesh type(Mesh2D),target :: mesh ! Mesh class type(SEMQuad),target :: geometry ! Geometry class - character(LEN=255) :: WORKSPACE ! Used for file I/O real(prec),parameter :: g = 1.0_prec ! Acceleration due to gravity real(prec),parameter :: H = 1.0_prec ! Uniform resting depth diff --git a/src/SELF_DGModel1D_t.f90 b/src/SELF_DGModel1D_t.f90 index a82f55cb..26256bb2 100644 --- a/src/SELF_DGModel1D_t.f90 +++ b/src/SELF_DGModel1D_t.f90 @@ -299,7 +299,7 @@ subroutine CalculateEntropy_DGModel1D_t(this) implicit none class(DGModel1D_t),intent(inout) :: this ! Local - integer :: iel,i,ivar + integer :: iel,i real(prec) :: e,s(1:this%solution%nvar),J e = 0.0_prec @@ -323,7 +323,6 @@ subroutine setboundarycondition_DGModel1D_t(this) implicit none class(DGModel1D_t),intent(inout) :: this ! local - integer :: ivar integer :: N,nelem real(prec) :: x @@ -627,10 +626,6 @@ subroutine Read_DGModel1D_t(this,fileName) character(*),intent(in) :: fileName ! Local integer(HID_T) :: fileId - integer(HID_T) :: solOffset(1:3) - integer :: firstElem - integer :: N - call Open_HDF5(fileName,H5F_ACC_RDWR_F,fileId) call ReadArray_HDF5(fileId,'/controlgrid/solution/interior',this%solution%interior) call Close_HDF5(fileId) @@ -643,14 +638,12 @@ subroutine WriteTecplot_DGModel1D_t(this,filename) class(DGModel1D_t),intent(inout) :: this character(*),intent(in),optional :: filename ! Local - character(8) :: zoneID integer :: fUnit integer :: iEl,i,iVar character(LEN=self_FileNameLength) :: tecFile character(LEN=self_TecplotHeaderLength) :: tecHeader character(LEN=self_FormatLength) :: fmat character(13) :: timeStampString - character(5) :: rankString type(Scalar1D) :: solution type(Scalar1D) :: x type(Lagrange),target :: interp diff --git a/src/SELF_DGModel2D_t.f90 b/src/SELF_DGModel2D_t.f90 index c3e0f84a..df9751af 100644 --- a/src/SELF_DGModel2D_t.f90 +++ b/src/SELF_DGModel2D_t.f90 @@ -92,10 +92,6 @@ subroutine Init_DGModel2D_t(this,mesh,geometry) type(Mesh2D),intent(in),target :: mesh type(SEMQuad),intent(in),target :: geometry ! Local - integer :: ivar - character(LEN=3) :: ivarChar - character(LEN=25) :: varname - this%mesh => mesh this%geometry => geometry call this%SetNumberOfVariables() @@ -650,7 +646,7 @@ subroutine Read_DGModel2D_t(this,fileName) integer(HID_T) :: fileId integer(HID_T) :: solOffset(1:3) integer :: firstElem - integer :: N,ivar + integer :: ivar if(this%mesh%decomp%mpiEnabled) then call Open_HDF5(fileName,H5F_ACC_RDWR_F,fileId, & diff --git a/src/SELF_DGModel3D_t.f90 b/src/SELF_DGModel3D_t.f90 index dd6a303e..6b865116 100644 --- a/src/SELF_DGModel3D_t.f90 +++ b/src/SELF_DGModel3D_t.f90 @@ -92,10 +92,6 @@ subroutine Init_DGModel3D_t(this,mesh,geometry) type(Mesh3D),intent(in),target :: mesh type(SEMHex),intent(in),target :: geometry ! Local - integer :: ivar - character(LEN=3) :: ivarChar - character(LEN=25) :: varname - this%mesh => mesh this%geometry => geometry call this%SetNumberOfVariables() diff --git a/src/SELF_Geometry_2D.f90 b/src/SELF_Geometry_2D.f90 index 64033f31..7d84a2b5 100644 --- a/src/SELF_Geometry_2D.f90 +++ b/src/SELF_Geometry_2D.f90 @@ -263,7 +263,7 @@ subroutine WriteTecplot_SEMQuad(this,filename) ! Local character(8) :: zoneID integer :: fUnit - integer :: iEl,i,j,iVar + integer :: iEl,i,j character(LEN=self_TecplotHeaderLength) :: tecHeader character(LEN=self_FormatLength) :: fmat diff --git a/src/SELF_Geometry_3D.f90 b/src/SELF_Geometry_3D.f90 index 8c35a191..6dc0a1b3 100644 --- a/src/SELF_Geometry_3D.f90 +++ b/src/SELF_Geometry_3D.f90 @@ -412,7 +412,7 @@ subroutine WriteTecplot_SEMHex(this,filename) ! Local character(8) :: zoneID integer :: fUnit - integer :: iEl,i,j,k,iVar + integer :: iEl,i,j,k character(LEN=self_TecplotHeaderLength) :: tecHeader character(LEN=self_FormatLength) :: fmat diff --git a/src/SELF_LinearEuler2D_t.f90 b/src/SELF_LinearEuler2D_t.f90 index b716f30e..b59ad51a 100644 --- a/src/SELF_LinearEuler2D_t.f90 +++ b/src/SELF_LinearEuler2D_t.f90 @@ -126,8 +126,6 @@ pure function hbc2d_NoNormalFlow_LinearEuler2D_t(this,s,nhat) result(exts) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: nhat(1:2) real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar exts(1) = s(1) ! density exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u @@ -150,6 +148,7 @@ pure function flux2d_LinearEuler2D_t(this,s,dsdx) result(flux) flux(3,2) = s(4)/this%rho0 ! y-velocity, y flux; p/rho0 flux(4,1) = this%c*this%c*this%rho0*s(2) ! pressure, x flux : rho0*c^2*u flux(4,2) = this%c*this%c*this%rho0*s(3) ! pressure, y flux : rho0*c^2*v + if(.false.) flux(1,1) = flux(1,1)+dsdx(1,1) ! suppress unused-dummy-argument warning endfunction flux2d_LinearEuler2D_t @@ -186,6 +185,7 @@ pure function riemannflux2d_LinearEuler2D_t(this,sL,sR,dsdx,nhat) result(flux) fR(4) = rho0*c*c*(u*nhat(1)+v*nhat(2)) ! pressure flux(1:4) = 0.5_prec*(fL(1:4)+fR(1:4))+c*(sL(1:4)-sR(1:4)) + if(.false.) flux(1) = flux(1)+dsdx(1,1) ! suppress unused-dummy-argument warning endfunction riemannflux2d_LinearEuler2D_t @@ -207,7 +207,7 @@ subroutine SphericalSoundWave_LinearEuler2D_t(this,rhoprime,Lr,x0,y0) real(prec),intent(in) :: rhoprime,Lr,x0,y0 ! Local integer :: i,j,iEl - real(prec) :: x,y,rho,r,E + real(prec) :: x,y,rho,r print*,__FILE__," : Configuring weak blast wave initial condition. " print*,__FILE__," : rhoprime = ",rhoprime diff --git a/src/SELF_LinearEuler3D_t.f90 b/src/SELF_LinearEuler3D_t.f90 index cf059fdf..e51ca033 100644 --- a/src/SELF_LinearEuler3D_t.f90 +++ b/src/SELF_LinearEuler3D_t.f90 @@ -145,7 +145,7 @@ subroutine sourcemethod_LinearEuler3D_t(this) implicit none class(LinearEuler3D_t),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! suppress unused-dummy-argument warning endsubroutine sourcemethod_LinearEuler3D_t @@ -174,6 +174,7 @@ pure function flux3D_LinearEuler3D_t(this,s,dsdx) result(flux) flux(5,1) = this%c*this%c*this%rho0*s(2) ! pressure, x flux : rho0*c^2*u flux(5,2) = this%c*this%c*this%rho0*s(3) ! pressure, y flux : rho0*c^2*v flux(5,3) = this%c*this%c*this%rho0*s(4) ! pressure, y flux : rho0*c^2*w + if(.false.) flux(1,1) = flux(1,1)+dsdx(1,1) ! suppress unused-dummy-argument warning endfunction flux3D_LinearEuler3D_t @@ -214,6 +215,7 @@ pure function riemannflux3D_LinearEuler3D_t(this,sL,sR,dsdx,nhat) result(flux) fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) + if(.false.) flux(1) = flux(1)+dsdx(1,1) ! suppress unused-dummy-argument warning endfunction riemannflux3D_LinearEuler3D_t @@ -235,7 +237,7 @@ subroutine SphericalSoundWave_LinearEuler3D_t(this,rhoprime,Lr,x0,y0,z0) real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 ! Local integer :: i,j,k,iEl - real(prec) :: x,y,z,rho,r,E + real(prec) :: x,y,z,rho,r print*,__FILE__," : Configuring weak blast wave initial condition. " print*,__FILE__," : rhoprime = ",rhoprime diff --git a/src/SELF_LinearShallowWater2D_t.f90 b/src/SELF_LinearShallowWater2D_t.f90 index 69121d62..47fa9360 100644 --- a/src/SELF_LinearShallowWater2D_t.f90 +++ b/src/SELF_LinearShallowWater2D_t.f90 @@ -193,6 +193,7 @@ pure function flux2d_LinearShallowWater2D_t(this,s,dsdx) result(flux) flux(2,2) = this%g*s(3) flux(3,1) = this%H*s(1) flux(3,2) = this%H*s(2) + if(.false.) flux(1,1) = flux(1,1)+dsdx(1,1) ! suppress unused-dummy-argument warning endfunction flux2d_LinearShallowWater2D_t @@ -216,6 +217,7 @@ pure function riemannflux2d_LinearShallowWater2D_t(this,sL,sR,dsdx,nhat) result( flux(1) = 0.5_prec*(this%g*(sL(3)+sR(3))+c*(unL-unR))*nhat(1) flux(2) = 0.5_prec*(this%g*(sL(3)+sR(3))+c*(unL-unR))*nhat(2) flux(3) = 0.5_prec*(this%H*(unL+unR)+c*(sL(3)-sR(3))) + if(.false.) flux(1) = flux(1)+dsdx(1,1) ! suppress unused-dummy-argument warning endfunction riemannflux2d_LinearShallowWater2D_t @@ -224,8 +226,6 @@ pure function hbc2d_NoNormalFlow_LinearShallowWater2D_t(this,s,nhat) result(exts real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: nhat(1:2) real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar exts(1) = (nhat(2)**2-nhat(1)**2)*s(1)-2.0_prec*nhat(1)*nhat(2)*s(2) ! u exts(2) = (nhat(1)**2-nhat(2)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(1) ! v diff --git a/src/SELF_MappedScalar_1D_t.f90 b/src/SELF_MappedScalar_1D_t.f90 index 198b89bb..59a53189 100644 --- a/src/SELF_MappedScalar_1D_t.f90 +++ b/src/SELF_MappedScalar_1D_t.f90 @@ -95,6 +95,7 @@ subroutine SetInteriorFromEquation_MappedScalar1D_t(this,time) ! Local integer :: iVar + if(.false.) this%N = int(time) ! suppress unused-dummy-argument warning do ivar = 1,this%nvar this%interior(:,:,ivar) = this%eqn(ivar)%evaluate(this%geometry%x%interior) enddo diff --git a/src/SELF_MappedScalar_2D_t.f90 b/src/SELF_MappedScalar_2D_t.f90 index 64e6fff7..ca672748 100644 --- a/src/SELF_MappedScalar_2D_t.f90 +++ b/src/SELF_MappedScalar_2D_t.f90 @@ -180,7 +180,6 @@ subroutine ApplyFlip_MappedScalar2D_t(this,mesh) integer :: e1,s1,e2,s2 integer :: i,i2 integer :: r2,flip,ivar - integer :: globalSideId real(prec) :: extBuff(1:this%interp%N+1) do ivar = 1,this%nvar diff --git a/src/SELF_Mesh_2D_t.f90 b/src/SELF_Mesh_2D_t.f90 index b1ea9c4a..f8ec2a9e 100644 --- a/src/SELF_Mesh_2D_t.f90 +++ b/src/SELF_Mesh_2D_t.f90 @@ -132,9 +132,6 @@ subroutine Init_Mesh2D_t(this,nGeo,nElem,nSides,nNodes,nBCs) integer,intent(in) :: nSides integer,intent(in) :: nNodes integer,intent(in) :: nBCs - ! Local - integer :: i,j,l - this%nGeo = nGeo this%nElem = nElem this%nGlobalElem = nElem @@ -196,9 +193,7 @@ subroutine Free_Mesh2D_t(this) subroutine UpdateDevice_Mesh2D_t(this) implicit none class(Mesh2D_t),intent(inout) :: this - - return - + if(.false.) this%nElem = this%nElem ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Mesh2D_t subroutine ResetBoundaryConditionType_Mesh2D_t(this,bcid) @@ -644,15 +639,8 @@ subroutine RecalculateFlip_Mesh2D_t(this) integer :: nid2(1:2,1:4,1:this%nElem) integer :: nloc1(1:2) integer :: nloc2(1:2) - integer :: n1 - integer :: n1Global - integer :: n2 - integer :: n2Global - integer :: c1 - integer :: c2 integer :: i,j integer :: l - integer :: nShifts integer :: neighborRank integer :: rankId integer :: offset diff --git a/src/SELF_Mesh_3D_t.f90 b/src/SELF_Mesh_3D_t.f90 index 9913a9f8..e3b54c87 100644 --- a/src/SELF_Mesh_3D_t.f90 +++ b/src/SELF_Mesh_3D_t.f90 @@ -185,9 +185,6 @@ subroutine Init_Mesh3D_t(this,nGeo,nElem,nSides,nNodes,nBCs) integer,intent(in) :: nSides integer,intent(in) :: nNodes integer,intent(in) :: nBCs - ! Local - integer :: i,j,k,l - this%nElem = nElem this%nGlobalElem = nElem this%nGeo = nGeo @@ -271,9 +268,7 @@ subroutine Free_Mesh3D_t(this) subroutine UpdateDevice_Mesh3D_t(this) implicit none class(Mesh3D_t),intent(inout) :: this - - return - + if(.false.) this%nElem = this%nElem ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Mesh3D_t subroutine ResetBoundaryConditionType_Mesh3D_t(this,bcid) @@ -343,6 +338,7 @@ pure function elementid(i,j,k,ti,tj,tk,nxpertile,nypertile,nzpertile, & eid = i+nxpertile*(j-1+nypertile*(k-1+nzpertile*( & ti-1+ntilex*(tj-1+ntiley*(tk-1))))) + if(.false.) eid = eid+ntilez ! suppress unused-dummy-argument warning endfunction elementid diff --git a/src/SELF_Model.f90 b/src/SELF_Model.f90 index 76c10abf..c3768df0 100644 --- a/src/SELF_Model.f90 +++ b/src/SELF_Model.f90 @@ -278,20 +278,20 @@ subroutine SetNumberOfVariables_Model(this) subroutine AdditionalInit_Model(this) implicit none class(Model),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! Default implementation; suppress unused-dummy-argument warning endsubroutine AdditionalInit_Model subroutine AdditionalFree_Model(this) implicit none class(Model),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! Default implementation; suppress unused-dummy-argument warning endsubroutine AdditionalFree_Model subroutine AdditionalOutput_Model(this,fileid) implicit none class(Model),intent(inout) :: this integer(HID_T),intent(in) :: fileid - return + if(.false.) this%nvar = int(fileid) ! Default implementation; suppress unused-dummy-argument warning endsubroutine AdditionalOutput_Model subroutine PrintType_Model(this) @@ -299,6 +299,7 @@ subroutine PrintType_Model(this) class(Model),intent(in) :: this print*,__FILE__//" : Model : No model type" + if(.false.) write(*,*) this%nvar ! suppress unused-dummy-argument warning endsubroutine PrintType_Model @@ -313,7 +314,7 @@ subroutine PreTendency_Model(this) implicit none class(Model),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! suppress unused-dummy-argument warning endsubroutine PreTendency_Model @@ -323,6 +324,7 @@ pure function entropy_func_Model(this,s) result(e) real(prec) :: e e = 0.0_prec + if(.false.) e = e+s(1) ! suppress unused-dummy-argument warning endfunction entropy_func_Model @@ -333,12 +335,11 @@ pure function riemannflux1d_Model(this,sL,sR,dsdx,nhat) result(flux) real(prec),intent(in) :: dsdx(1:this%nvar) real(prec),intent(in) :: nhat real(prec) :: flux(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - flux(ivar) = 0.0_prec - enddo + flux = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + flux = sL+sR+dsdx; flux(1) = flux(1)+nhat + endif endfunction riemannflux1d_Model @@ -349,12 +350,11 @@ pure function riemannflux2d_Model(this,sL,sR,dsdx,nhat) result(flux) real(prec),intent(in) :: dsdx(1:this%nvar,1:2) real(prec),intent(in) :: nhat(1:2) real(prec) :: flux(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - flux(ivar) = 0.0_prec - enddo + flux = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + flux = sL+sR; flux(1) = flux(1)+dsdx(1,1)+nhat(1) + endif endfunction riemannflux2d_Model @@ -365,12 +365,11 @@ pure function riemannflux3d_Model(this,sL,sR,dsdx,nhat) result(flux) real(prec),intent(in) :: dsdx(1:this%nvar,1:3) real(prec),intent(in) :: nhat(1:3) real(prec) :: flux(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - flux(ivar) = 0.0_prec - enddo + flux = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + flux = sL+sR; flux(1) = flux(1)+dsdx(1,1)+nhat(1) + endif endfunction riemannflux3d_Model @@ -379,12 +378,9 @@ pure function flux1d_Model(this,s,dsdx) result(flux) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: dsdx(1:this%nvar) real(prec) :: flux(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - flux(ivar) = 0.0_prec - enddo + flux = 0.0_prec + if(.false.) flux = s+dsdx ! suppress unused-dummy-argument warnings for default implementation endfunction flux1d_Model @@ -393,12 +389,11 @@ pure function flux2d_Model(this,s,dsdx) result(flux) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: dsdx(1:this%nvar,1:2) real(prec) :: flux(1:this%nvar,1:2) - ! Local - integer :: ivar - do ivar = 1,this%nvar - flux(ivar,1:2) = 0.0_prec - enddo + flux = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + flux(:,1) = s; flux(1,:) = flux(1,:)+dsdx(1,:) + endif endfunction flux2d_Model @@ -407,12 +402,11 @@ pure function flux3d_Model(this,s,dsdx) result(flux) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: dsdx(1:this%nvar,1:3) real(prec) :: flux(1:this%nvar,1:3) - ! Local - integer :: ivar - do ivar = 1,this%nvar - flux(ivar,1:3) = 0.0_prec - enddo + flux = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + flux(:,1) = s; flux(1,:) = flux(1,:)+dsdx(1,:) + endif endfunction flux3d_Model @@ -421,12 +415,9 @@ pure function source1d_Model(this,s,dsdx) result(source) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: dsdx(1:this%nvar) real(prec) :: source(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - source(ivar) = 0.0_prec - enddo + source = 0.0_prec + if(.false.) source = s+dsdx ! suppress unused-dummy-argument warnings for default implementation endfunction source1d_Model @@ -435,12 +426,11 @@ pure function source2d_Model(this,s,dsdx) result(source) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: dsdx(1:this%nvar,1:2) real(prec) :: source(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - source(ivar) = 0.0_prec - enddo + source = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + source = s; source(1) = source(1)+dsdx(1,1) + endif endfunction source2d_Model @@ -449,12 +439,11 @@ pure function source3d_Model(this,s,dsdx) result(source) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: dsdx(1:this%nvar,1:3) real(prec) :: source(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - source(ivar) = 0.0_prec - enddo + source = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + source = s; source(1) = source(1)+dsdx(1,1) + endif endfunction source3d_Model @@ -463,12 +452,11 @@ pure function hbc1d_Generic_Model(this,s,nhat) result(exts) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: nhat real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo + exts = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + exts = s; exts(1) = exts(1)+nhat + endif endfunction hbc1d_Generic_Model @@ -477,12 +465,9 @@ pure function hbc1d_Prescribed_Model(this,x,t) result(exts) real(prec),intent(in) :: x real(prec),intent(in) :: t real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo + exts = 0.0_prec + if(.false.) exts(1) = exts(1)+x+t ! suppress unused-dummy-argument warnings for default implementation endfunction hbc1d_Prescribed_Model @@ -491,12 +476,11 @@ pure function hbc2d_Generic_Model(this,s,nhat) result(exts) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: nhat(1:2) real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo + exts = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + exts = s; exts(1) = exts(1)+nhat(1) + endif endfunction hbc2d_Generic_Model @@ -505,12 +489,9 @@ pure function hbc2d_Prescribed_Model(this,x,t) result(exts) real(prec),intent(in) :: x(1:2) real(prec),intent(in) :: t real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo + exts = 0.0_prec + if(.false.) exts(1) = exts(1)+x(1)+t ! suppress unused-dummy-argument warnings for default implementation endfunction hbc2d_Prescribed_Model @@ -519,12 +500,11 @@ pure function hbc3d_Generic_Model(this,s,nhat) result(exts) real(prec),intent(in) :: s(1:this%nvar) real(prec),intent(in) :: nhat(1:3) real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo + exts = 0.0_prec + if(.false.) then ! suppress unused-dummy-argument warnings for default implementation + exts = s; exts(1) = exts(1)+nhat(1) + endif endfunction hbc3d_Generic_Model @@ -533,12 +513,9 @@ pure function hbc3d_Prescribed_Model(this,x,t) result(exts) real(prec),intent(in) :: x(1:3) real(prec),intent(in) :: t real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo + exts = 0.0_prec + if(.false.) exts(1) = exts(1)+x(1)+t ! suppress unused-dummy-argument warnings for default implementation endfunction hbc3d_Prescribed_Model @@ -547,12 +524,9 @@ pure function pbc1d_Generic_Model(this,dsdx,nhat) result(extDsdx) real(prec),intent(in) :: dsdx(1:this%nvar) real(prec),intent(in) :: nhat real(prec) :: extDsdx(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - extDsdx(ivar) = dsdx(ivar) - enddo + extDsdx = dsdx + if(.false.) extDsdx(1) = extDsdx(1)+nhat ! suppress unused-dummy-argument warning for default implementation endfunction pbc1d_Generic_Model @@ -561,12 +535,9 @@ pure function pbc1d_Prescribed_Model(this,x,t) result(extDsdx) real(prec),intent(in) :: x real(prec),intent(in) :: t real(prec) :: extDsdx(1:this%nvar) - ! Local - integer :: ivar - do ivar = 1,this%nvar - extDsdx(ivar) = 0.0_prec - enddo + extDsdx = 0.0_prec + if(.false.) extDsdx(1) = extDsdx(1)+x+t ! suppress unused-dummy-argument warnings for default implementation endfunction pbc1d_Prescribed_Model @@ -575,12 +546,9 @@ pure function pbc2d_Generic_Model(this,dsdx,nhat) result(extDsdx) real(prec),intent(in) :: dsdx(1:this%nvar,1:2) real(prec),intent(in) :: nhat(1:2) real(prec) :: extDsdx(1:this%nvar,1:2) - ! Local - integer :: ivar - do ivar = 1,this%nvar - extDsdx(ivar,1:2) = dsdx(ivar,1:2) - enddo + extDsdx = dsdx + if(.false.) extDsdx(1,1) = extDsdx(1,1)+nhat(1) ! suppress unused-dummy-argument warning for default implementation endfunction pbc2d_Generic_Model @@ -589,12 +557,9 @@ pure function pbc2d_Prescribed_Model(this,x,t) result(extDsdx) real(prec),intent(in) :: x(1:2) real(prec),intent(in) :: t real(prec) :: extDsdx(1:this%nvar,1:2) - ! Local - integer :: ivar - do ivar = 1,this%nvar - extDsdx(ivar,1:2) = 0.0_prec - enddo + extDsdx = 0.0_prec + if(.false.) extDsdx(1,1) = extDsdx(1,1)+x(1)+t ! suppress unused-dummy-argument warnings for default implementation endfunction pbc2d_Prescribed_Model @@ -603,12 +568,9 @@ pure function pbc3d_Generic_Model(this,dsdx,nhat) result(extDsdx) real(prec),intent(in) :: dsdx(1:this%nvar,1:3) real(prec),intent(in) :: nhat(1:3) real(prec) :: extDsdx(1:this%nvar,1:3) - ! Local - integer :: ivar - do ivar = 1,this%nvar - extDsdx(ivar,1:3) = dsdx(ivar,1:3) - enddo + extDsdx = dsdx + if(.false.) extDsdx(1,1) = extDsdx(1,1)+nhat(1) ! suppress unused-dummy-argument warning for default implementation endfunction pbc3d_Generic_Model @@ -617,12 +579,9 @@ pure function pbc3d_Prescribed_Model(this,x,t) result(extDsdx) real(prec),intent(in) :: x(1:3) real(prec),intent(in) :: t real(prec) :: extDsdx(1:this%nvar,1:3) - ! Local - integer :: ivar - do ivar = 1,this%nvar - extDsdx(ivar,1:3) = 0.0_prec - enddo + extDsdx = 0.0_prec + if(.false.) extDsdx(1,1) = extDsdx(1,1)+x(1)+t ! suppress unused-dummy-argument warnings for default implementation endfunction pbc3d_Prescribed_Model @@ -714,7 +673,6 @@ subroutine ReportEntropy_Model(this) ! Local character(len=20) :: modelTime character(len=20) :: entropy - character(len=:),allocatable :: str ! Copy the time and entropy to a string write(modelTime,"(ES16.7E3)") this%t @@ -722,11 +680,8 @@ subroutine ReportEntropy_Model(this) ! Write the output to STDOUT open(output_unit,ENCODING='utf-8') - write(output_unit,'(1x,A," : ")',ADVANCE='no') __FILE__ - str = 'tᵢ ='//trim(modelTime) - write(output_unit,'(A)',ADVANCE='no') str - str = ' | eᵢ ='//trim(entropy) - write(output_unit,'(A)',ADVANCE='yes') str + write(output_unit,'(1x,A," : ",A,A)') __FILE__, & + 'tᵢ ='//trim(modelTime),' | eᵢ ='//trim(entropy) endsubroutine ReportEntropy_Model @@ -735,7 +690,7 @@ subroutine ReportMetrics_Model(this) !! report their own custom metrics after file io implicit none class(Model),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! Default implementation; suppress unused-dummy-argument warning endsubroutine ReportMetrics_Model subroutine ReportUserMetrics_Model(this) @@ -743,7 +698,7 @@ subroutine ReportUserMetrics_Model(this) !! report their own custom metrics after file io implicit none class(Model),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! Default implementation; suppress unused-dummy-argument warning endsubroutine ReportUserMetrics_Model ! ////////////////////////////////////// ! diff --git a/src/SELF_Scalar_1D_t.f90 b/src/SELF_Scalar_1D_t.f90 index 20f4951f..576b6370 100644 --- a/src/SELF_Scalar_1D_t.f90 +++ b/src/SELF_Scalar_1D_t.f90 @@ -118,13 +118,13 @@ subroutine Free_Scalar1D_t(this) subroutine UpdateHost_Scalar1D_t(this) implicit none class(Scalar1D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Scalar1D_t subroutine UpdateDevice_Scalar1D_t(this) implicit none class(Scalar1D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Scalar1D_t subroutine AverageSides_Scalar1D_t(this) diff --git a/src/SELF_Scalar_2D_t.f90 b/src/SELF_Scalar_2D_t.f90 index 2296852f..a84e6a77 100644 --- a/src/SELF_Scalar_2D_t.f90 +++ b/src/SELF_Scalar_2D_t.f90 @@ -119,13 +119,13 @@ subroutine Free_Scalar2D_t(this) subroutine UpdateHost_Scalar2D_t(this) implicit none class(Scalar2D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Scalar2D_t subroutine UpdateDevice_Scalar2D_t(this) implicit none class(Scalar2D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Scalar2D_t subroutine BoundaryInterp_Scalar2D_t(this) diff --git a/src/SELF_Scalar_3D_t.f90 b/src/SELF_Scalar_3D_t.f90 index 01423189..b068a1ae 100644 --- a/src/SELF_Scalar_3D_t.f90 +++ b/src/SELF_Scalar_3D_t.f90 @@ -119,13 +119,13 @@ subroutine Free_Scalar3D_t(this) subroutine UpdateHost_Scalar3D_t(this) implicit none class(Scalar3D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Scalar3D_t subroutine UpdateDevice_Scalar3D_t(this) implicit none class(Scalar3D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Scalar3D_t subroutine BoundaryInterp_Scalar3D_t(this) diff --git a/src/SELF_Tensor_2D_t.f90 b/src/SELF_Tensor_2D_t.f90 index 2397a945..c243a46d 100644 --- a/src/SELF_Tensor_2D_t.f90 +++ b/src/SELF_Tensor_2D_t.f90 @@ -120,13 +120,13 @@ subroutine Free_Tensor2D_t(this) subroutine UpdateHost_Tensor2D_t(this) implicit none class(Tensor2D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Tensor2D_t subroutine UpdateDevice_Tensor2D_t(this) implicit none class(Tensor2D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Tensor2D_t subroutine BoundaryInterp_Tensor2D_t(this) diff --git a/src/SELF_Tensor_3D_t.f90 b/src/SELF_Tensor_3D_t.f90 index 1e789bfd..ca81c99c 100644 --- a/src/SELF_Tensor_3D_t.f90 +++ b/src/SELF_Tensor_3D_t.f90 @@ -120,13 +120,13 @@ subroutine Free_Tensor3D_t(this) subroutine UpdateHost_Tensor3D_t(this) implicit none class(Tensor3D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Tensor3D_t subroutine UpdateDevice_Tensor3D_t(this) implicit none class(Tensor3D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Tensor3D_t subroutine BoundaryInterp_Tensor3D_t(this) diff --git a/src/SELF_Vector_2D_t.f90 b/src/SELF_Vector_2D_t.f90 index 58e13b01..f004b056 100644 --- a/src/SELF_Vector_2D_t.f90 +++ b/src/SELF_Vector_2D_t.f90 @@ -142,13 +142,13 @@ subroutine Free_Vector2D_t(this) subroutine UpdateHost_Vector2D_t(this) implicit none class(Vector2D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Vector2D_t subroutine UpdateDevice_Vector2D_t(this) implicit none class(Vector2D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Vector2D_t subroutine SetEquation_Vector2D_t(this,idir,ivar,eqnChar) diff --git a/src/SELF_Vector_3D_t.f90 b/src/SELF_Vector_3D_t.f90 index 1dd4ebb8..4ad9d7a6 100644 --- a/src/SELF_Vector_3D_t.f90 +++ b/src/SELF_Vector_3D_t.f90 @@ -145,13 +145,13 @@ subroutine Free_Vector3D_t(this) subroutine UpdateHost_Vector3D_t(this) implicit none class(Vector3D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateHost_Vector3D_t subroutine UpdateDevice_Vector3D_t(this) implicit none class(Vector3D_t),intent(inout) :: this - + if(.false.) this%N = this%N ! CPU stub; suppress unused-dummy-argument warning endsubroutine UpdateDevice_Vector3D_t subroutine SetEquation_Vector3D_t(this,idir,ivar,eqnChar) diff --git a/src/gpu/SELF_DGModel1D.f90 b/src/gpu/SELF_DGModel1D.f90 index 55d42de3..5e027b00 100644 --- a/src/gpu/SELF_DGModel1D.f90 +++ b/src/gpu/SELF_DGModel1D.f90 @@ -152,7 +152,7 @@ subroutine CalculateEntropy_DGModel1D(this) implicit none class(DGModel1D),intent(inout) :: this ! Local - integer :: iel,i,ivar + integer :: iel,i real(prec) :: e,s(1:this%solution%nvar),J call gpuCheck(hipMemcpy(c_loc(this%solution%interior), & @@ -180,7 +180,6 @@ subroutine setboundarycondition_DGModel1D(this) implicit none class(DGModel1D),intent(inout) :: this ! local - integer :: ivar integer :: N,nelem real(prec) :: x @@ -252,7 +251,6 @@ subroutine setgradientboundarycondition_DGModel1D(this) implicit none class(DGModel1D),intent(inout) :: this ! local - integer :: ivar integer :: nelem real(prec) :: x diff --git a/src/gpu/SELF_GPU.f90 b/src/gpu/SELF_GPU.f90 index bd3fe80b..bcc39371 100644 --- a/src/gpu/SELF_GPU.f90 +++ b/src/gpu/SELF_GPU.f90 @@ -40,7 +40,7 @@ function hipGetDeviceCount_(count) bind(c,name="cudaGetDeviceCount") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(hipSuccess)) :: hipGetDeviceCount_ + integer(c_int) :: hipGetDeviceCount_ integer(c_int) :: count endfunction endinterface @@ -54,7 +54,7 @@ function hipSetDevice_(device_id) bind(c,name="cudaSetDevice") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(hipSuccess)) :: hipSetDevice_ + integer(c_int) :: hipSetDevice_ integer(c_int),value :: device_id endfunction endinterface @@ -67,7 +67,7 @@ function hipMalloc_(ptr,mySize) bind(c,name="cudaMalloc") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(hipSuccess)) :: hipMalloc_ + integer(c_int) :: hipMalloc_ type(c_ptr) :: ptr integer(c_size_t),value :: mySize endfunction @@ -82,7 +82,7 @@ function hipFree_(ptr) bind(c,name="cudaFree") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(hipSuccess)) :: hipFree_ + integer(c_int) :: hipFree_ type(c_ptr),value :: ptr endfunction endinterface hipFree @@ -96,19 +96,20 @@ function hipMemcpy_(dest,src,sizeBytes,myKind) bind(c,name="cudaMemcpy") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(hipSuccess)) :: hipMemcpy_ + integer(c_int) :: hipMemcpy_ type(c_ptr),value :: dest type(c_ptr),value :: src integer(c_size_t),value :: sizeBytes - integer(kind(hipMemcpyHostToHost)),value :: myKind + integer(c_int),value :: myKind endfunction hipMemcpy_ endinterface hipMemcpy contains subroutine gpuCheck(gpuError_t) + use iso_c_binding implicit none - integer(kind(hipSuccess)) :: gpuError_t + integer(c_int) :: gpuError_t if(gpuError_t /= hipSuccess) then write(*,*) "GPU ERROR: Error code = ",gpuError_t diff --git a/src/gpu/SELF_GPUBLAS.f90 b/src/gpu/SELF_GPUBLAS.f90 index b8e21793..d7466b3d 100644 --- a/src/gpu/SELF_GPUBLAS.f90 +++ b/src/gpu/SELF_GPUBLAS.f90 @@ -16,7 +16,7 @@ function hipblasCreate_(handle) bind(c,name="hipblasCreate") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasCreate_ + integer(c_int) :: hipblasCreate_ type(c_ptr) :: handle endfunction endinterface @@ -30,7 +30,7 @@ function hipblasDestroy_(handle) bind(c,name="hipblasDestroy") use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasDestroy_ + integer(c_int) :: hipblasDestroy_ type(c_ptr),value :: handle endfunction endinterface @@ -44,10 +44,10 @@ function hipblasSgemm_(handle,transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasSgemm_ + integer(c_int) :: hipblasSgemm_ type(c_ptr),value :: handle - integer(kind(HIPBLAS_OP_N)),value :: transa - integer(kind(HIPBLAS_OP_N)),value :: transb + integer(c_int),value :: transa + integer(c_int),value :: transb integer(c_int),value :: m integer(c_int),value :: n integer(c_int),value :: k @@ -71,10 +71,10 @@ function hipblasDgemm_(handle,transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasDgemm_ + integer(c_int) :: hipblasDgemm_ type(c_ptr),value :: handle - integer(kind(HIPBLAS_OP_N)),value :: transa - integer(kind(HIPBLAS_OP_N)),value :: transb + integer(c_int),value :: transa + integer(c_int),value :: transb integer(c_int),value :: m integer(c_int),value :: n integer(c_int),value :: k @@ -102,9 +102,9 @@ function hipblasSgemvStridedBatched_(handle,trans,m,n,alpha,A,lda,strideA,x, & use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasSgemvStridedBatched_ + integer(c_int) :: hipblasSgemvStridedBatched_ type(c_ptr),value :: handle - integer(kind(HIPBLAS_OP_N)),value :: trans + integer(c_int),value :: trans integer(c_int),value :: m integer(c_int),value :: n real(c_float) :: alpha @@ -136,9 +136,9 @@ function hipblasDgemvStridedBatched_(handle,trans,m,n,alpha,A,lda,strideA,x, & use iso_c_binding use SELF_GPU_enums implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasDgemvStridedBatched_ + integer(c_int) :: hipblasDgemvStridedBatched_ type(c_ptr),value :: handle - integer(kind(HIPBLAS_OP_N)),value :: trans + integer(c_int),value :: trans integer(c_int),value :: m integer(c_int),value :: n real(c_double) :: alpha @@ -168,8 +168,9 @@ function hipblasDgemvStridedBatched_(handle,trans,m,n,alpha,A,lda,strideA,x, & subroutine hipblasCheck(hipblasError_t) use SELF_GPU_enums + use iso_c_binding implicit none - integer(kind(HIPBLAS_STATUS_SUCCESS)) :: hipblasError_t + integer(c_int) :: hipblasError_t if(hipblasError_t /= HIPBLAS_STATUS_SUCCESS) then write(*,*) "GPUBLAS ERROR: Error code = ",hipblasError_t diff --git a/src/gpu/SELF_LinearEuler2D.f90 b/src/gpu/SELF_LinearEuler2D.f90 index 54e0fbc0..4680a233 100644 --- a/src/gpu/SELF_LinearEuler2D.f90 +++ b/src/gpu/SELF_LinearEuler2D.f90 @@ -76,7 +76,7 @@ subroutine sourcemethod_LinearEuler2D(this) implicit none class(LinearEuler2D),intent(inout) :: this - return + if(.false.) this%nvar = this%nvar ! suppress unused-dummy-argument warning endsubroutine sourcemethod_LinearEuler2D diff --git a/src/gpu/SELF_MappedScalar_1D.f90 b/src/gpu/SELF_MappedScalar_1D.f90 index b575436d..49e49241 100644 --- a/src/gpu/SELF_MappedScalar_1D.f90 +++ b/src/gpu/SELF_MappedScalar_1D.f90 @@ -78,6 +78,7 @@ subroutine SetInteriorFromEquation_MappedScalar1D(this,time) ! Local integer :: iVar + if(.false.) this%N = int(time) ! suppress unused-dummy-argument warning do ivar = 1,this%nvar this%interior(:,:,ivar) = this%eqn(ivar)%evaluate(this%geometry%x%interior) enddo @@ -136,9 +137,6 @@ subroutine MappedDerivative_MappedScalar1D(this,dF) implicit none class(MappedScalar1D),intent(in) :: this type(c_ptr),intent(inout) :: df - ! Local - integer :: iEl,iVar,i,ii - real(prec) :: dfloc call this%Derivative(df) call JacobianWeight_1D_gpu(df,this%geometry%dxds%interior_gpu,this%N,this%nVar,this%nelem) @@ -149,9 +147,6 @@ subroutine MappedDGDerivative_MappedScalar1D(this,dF) implicit none class(MappedScalar1D),intent(in) :: this type(c_ptr),intent(inout) :: df - ! Local - integer :: iEl,iVar,i,ii - real(prec) :: dfloc call self_blas_matrixop_1d(this%interp%dgMatrix_gpu, & this%interior_gpu, & diff --git a/src/gpu/SELF_MappedVector_2D.f90 b/src/gpu/SELF_MappedVector_2D.f90 index 74d278fd..75922705 100644 --- a/src/gpu/SELF_MappedVector_2D.f90 +++ b/src/gpu/SELF_MappedVector_2D.f90 @@ -162,10 +162,6 @@ subroutine SideExchange_MappedVector2D(this,mesh) class(MappedVector2D),intent(inout) :: this type(Mesh2D),intent(inout) :: mesh ! Local - integer :: e1,e2,s1,s2,e2Global - integer :: flip,bcid - integer :: i1,i2,ivar,idir - integer :: neighborRank integer :: offset offset = mesh%decomp%offsetElem(mesh%decomp%rankid+1) @@ -193,10 +189,6 @@ subroutine MappedDivergence_MappedVector2D(this,df) implicit none class(MappedVector2D),intent(inout) :: this type(c_ptr),intent(out) :: df - ! Local - real(prec),pointer :: f_p(:,:,:,:,:) - type(c_ptr) :: fc - ! Contravariant projection call ContravariantProjection_2D_gpu(this%interior_gpu, & this%geometry%dsdx%interior_gpu,this%interp%N,this%nvar,this%nelem) diff --git a/src/gpu/SELF_Mesh_2D.f90 b/src/gpu/SELF_Mesh_2D.f90 index 050a5264..a3c0c3d3 100644 --- a/src/gpu/SELF_Mesh_2D.f90 +++ b/src/gpu/SELF_Mesh_2D.f90 @@ -52,9 +52,6 @@ subroutine Init_Mesh2D(this,nGeo,nElem,nSides,nNodes,nBCs) integer,intent(in) :: nSides integer,intent(in) :: nNodes integer,intent(in) :: nBCs - ! Local - integer :: i,j,l - this%nGeo = nGeo this%nElem = nElem this%nGlobalElem = nElem diff --git a/src/gpu/SELF_Mesh_3D.f90 b/src/gpu/SELF_Mesh_3D.f90 index 55bf4fc9..9c0ad17f 100644 --- a/src/gpu/SELF_Mesh_3D.f90 +++ b/src/gpu/SELF_Mesh_3D.f90 @@ -52,9 +52,6 @@ subroutine Init_Mesh3D(this,nGeo,nElem,nSides,nNodes,nBCs) integer,intent(in) :: nSides integer,intent(in) :: nNodes integer,intent(in) :: nBCs - ! Local - integer :: i,j,k,l - this%nElem = nElem this%nGlobalElem = nElem this%nGeo = nGeo diff --git a/test/linear_shallow_water_2d_constant.f90 b/test/linear_shallow_water_2d_constant.f90 index 5f896748..fa0f31e2 100644 --- a/test/linear_shallow_water_2d_constant.f90 +++ b/test/linear_shallow_water_2d_constant.f90 @@ -44,7 +44,6 @@ program LinearShallowWater2D_constant type(Mesh2D),target :: mesh integer :: bcids(1:4) type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE ! Set boundary conditions bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South diff --git a/test/linear_shallow_water_2d_nonormalflow.f90 b/test/linear_shallow_water_2d_nonormalflow.f90 index e25e7020..300a37cd 100644 --- a/test/linear_shallow_water_2d_nonormalflow.f90 +++ b/test/linear_shallow_water_2d_nonormalflow.f90 @@ -45,7 +45,6 @@ program LinearShallowWater2D_nonormalflow integer :: bcids(1:4) type(Mesh2D),target :: mesh type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE ! Set no normal flow boundary conditions bcids(1:4) = [SELF_BC_NONORMALFLOW, & ! South diff --git a/test/linear_shallow_water_2d_radiation.f90 b/test/linear_shallow_water_2d_radiation.f90 index d037181a..a709d872 100644 --- a/test/linear_shallow_water_2d_radiation.f90 +++ b/test/linear_shallow_water_2d_radiation.f90 @@ -45,7 +45,6 @@ program LinearShallowWater2D_nonormalflow integer :: bcids(1:4) type(Mesh2D),target :: mesh type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE ! Set radiation boundary conditions bcids(1:4) = [SELF_BC_RADIATION, & ! South diff --git a/test/mappedscalarbrgradient_2d_constant_structuredmesh.f90 b/test/mappedscalarbrgradient_2d_constant_structuredmesh.f90 index 8004d7ff..6da43183 100644 --- a/test/mappedscalarbrgradient_2d_constant_structuredmesh.f90 +++ b/test/mappedscalarbrgradient_2d_constant_structuredmesh.f90 @@ -63,7 +63,6 @@ integer function mappedscalarbrgradient_2d_constant() result(r) integer :: iside integer :: i integer :: e2 - character(LEN=255) :: WORKSPACE integer :: bcids(1:4) ! Create an interpolant diff --git a/test/mappedscalarbrgradient_2d_linear.f90 b/test/mappedscalarbrgradient_2d_linear.f90 index 1137217f..3d058c37 100644 --- a/test/mappedscalarbrgradient_2d_linear.f90 +++ b/test/mappedscalarbrgradient_2d_linear.f90 @@ -63,7 +63,6 @@ integer function mappedscalarbrgradient_2d_linear() result(r) integer :: e2 character(LEN=255) :: WORKSPACE integer :: iel,j,i - integer(HID_T) :: fileId ! Create an interpolant call interp%Init(N=controlDegree, & diff --git a/test/mappedscalarbrgradient_2d_linear_mpi.f90 b/test/mappedscalarbrgradient_2d_linear_mpi.f90 index 5d42c654..54529ff9 100644 --- a/test/mappedscalarbrgradient_2d_linear_mpi.f90 +++ b/test/mappedscalarbrgradient_2d_linear_mpi.f90 @@ -63,7 +63,6 @@ integer function mappedscalarbrgradient_2d_linear() result(r) integer :: e2 character(LEN=255) :: WORKSPACE integer :: iel,j,i - integer(HID_T) :: fileId ! Create a uniform block mesh call get_environment_variable("WORKSPACE",WORKSPACE) diff --git a/test/mappedscalarbrgradient_2d_linear_structuredmesh.f90 b/test/mappedscalarbrgradient_2d_linear_structuredmesh.f90 index 86ecf145..d83f1763 100644 --- a/test/mappedscalarbrgradient_2d_linear_structuredmesh.f90 +++ b/test/mappedscalarbrgradient_2d_linear_structuredmesh.f90 @@ -61,9 +61,7 @@ integer function mappedscalarbrgradient_2d_linear() result(r) type(MappedVector2D) :: df integer :: iside integer :: e2 - character(LEN=255) :: WORKSPACE integer :: iel,j,i - integer(HID_T) :: fileId integer :: bcids(1:4) ! Create an interpolant diff --git a/test/mappedscalarbrgradient_3d_linear_structuredmesh.f90 b/test/mappedscalarbrgradient_3d_linear_structuredmesh.f90 index 86cdae22..2524b33a 100644 --- a/test/mappedscalarbrgradient_3d_linear_structuredmesh.f90 +++ b/test/mappedscalarbrgradient_3d_linear_structuredmesh.f90 @@ -64,7 +64,7 @@ integer function mappedscalarbrgradient_3d_linear() result(r) integer :: i integer :: j integer :: k - integer :: e2,s2,bcid + integer :: e2 integer :: bcids(1:6) ! Create an interpolant diff --git a/test/mappedscalargradient_2d_linear.f90 b/test/mappedscalargradient_2d_linear.f90 index f5122745..7f0118f8 100644 --- a/test/mappedscalargradient_2d_linear.f90 +++ b/test/mappedscalargradient_2d_linear.f90 @@ -61,7 +61,6 @@ integer function mappedscalargradient_2d_linear() result(r) type(MappedVector2D) :: df character(LEN=255) :: WORKSPACE integer :: iel,j,i - integer(HID_T) :: fileId ! Create an interpolant call interp%Init(N=controlDegree, & diff --git a/test/mappedvectordgdivergence_2d_linear_structuredmesh.f90 b/test/mappedvectordgdivergence_2d_linear_structuredmesh.f90 index 667fce02..e42de6d0 100644 --- a/test/mappedvectordgdivergence_2d_linear_structuredmesh.f90 +++ b/test/mappedvectordgdivergence_2d_linear_structuredmesh.f90 @@ -59,7 +59,6 @@ integer function mappedvectordgdivergence_2d_linear() result(r) type(SEMQuad),target :: geometry type(MappedVector2D) :: f type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE integer :: i,j,iel,e2,ivar real(prec) :: nhat(1:2),nmag,fx,fy,diff integer :: bcids(1:4) diff --git a/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 b/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 index 484fd0ce..f1388a8d 100644 --- a/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 +++ b/test/mappedvectordgdivergence_2d_linear_structuredmesh_mpi.f90 @@ -59,7 +59,6 @@ integer function mappedvectordgdivergence_2d_linear() result(r) type(SEMQuad),target :: geometry type(MappedVector2D) :: f type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE integer :: i,j,iel,e2 real(prec) :: nhat(1:2),nmag,fx,fy,diff integer :: bcids(1:4) diff --git a/test/mappedvectordgdivergence_3d_linear_sideexchange.f90 b/test/mappedvectordgdivergence_3d_linear_sideexchange.f90 index f6e1dda3..63a99f09 100644 --- a/test/mappedvectordgdivergence_3d_linear_sideexchange.f90 +++ b/test/mappedvectordgdivergence_3d_linear_sideexchange.f90 @@ -60,7 +60,7 @@ integer function mappedvectordgdivergence_3d_linear() result(r) type(MappedVector3D) :: f type(MappedScalar3D) :: df character(LEN=255) :: WORKSPACE - integer :: i,j,k,iel,e2,s2 + integer :: i,j,k,iel,e2 real(prec) :: nhat(1:3),nmag,fx,fy,fz ! Create an interpolant diff --git a/test/mappedvectordgdivergence_3d_linear_structuredmesh.f90 b/test/mappedvectordgdivergence_3d_linear_structuredmesh.f90 index 672e3bdb..f3b5495b 100644 --- a/test/mappedvectordgdivergence_3d_linear_structuredmesh.f90 +++ b/test/mappedvectordgdivergence_3d_linear_structuredmesh.f90 @@ -59,7 +59,7 @@ integer function mappedvectordgdivergence_3d_linear() result(r) type(SEMHex),target :: geometry type(MappedVector3D) :: f type(MappedScalar3D) :: df - integer :: i,j,k,iel,e2,s2 + integer :: i,j,k,iel,e2 real(prec) :: nhat(1:3),nmag,fx,fy,fz integer :: bcids(1:6) diff --git a/test/mappedvectordivergence_2d_linear_structuredmesh.f90 b/test/mappedvectordivergence_2d_linear_structuredmesh.f90 index 1de39090..f017a7f4 100644 --- a/test/mappedvectordivergence_2d_linear_structuredmesh.f90 +++ b/test/mappedvectordivergence_2d_linear_structuredmesh.f90 @@ -59,9 +59,7 @@ integer function mappedvectordgdivergence_2d_linear() result(r) type(SEMQuad),target :: geometry type(MappedVector2D) :: f type(MappedScalar2D) :: df - character(LEN=255) :: WORKSPACE - integer :: i,j,iel,e2,ivar - real(prec) :: nhat(1:2),nmag,fx,fy,diff + integer :: ivar integer :: bcids(1:4) ! Create an interpolant diff --git a/test/mesh2d_uniformstructured.f90 b/test/mesh2d_uniformstructured.f90 index 8f60b49b..865d2317 100644 --- a/test/mesh2d_uniformstructured.f90 +++ b/test/mesh2d_uniformstructured.f90 @@ -54,7 +54,6 @@ integer function mesh2d_setup() result(r) type(Lagrange),target :: interp type(Mesh2D),target :: mesh type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE integer :: bcids(1:4) ! Create an interpolant diff --git a/test/scalargridinterp_1d_constant.f90 b/test/scalargridinterp_1d_constant.f90 index 3b5e71ce..6371c68a 100644 --- a/test/scalargridinterp_1d_constant.f90 +++ b/test/scalargridinterp_1d_constant.f90 @@ -54,7 +54,6 @@ integer function scalargridinterp_1d_constant() result(r) type(Scalar1D) :: fTarget type(Lagrange),target :: interp type(Lagrange),target :: interpTarget - real(prec) :: imat ! Create an interpolant call interp%Init(N=controlDegree, &