From b87f3059f8dcb69702144387eadd56eb3d175235 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sun, 4 Oct 2026 22:59:14 -0600 Subject: [PATCH 01/12] feat(hipfft): add the generated Fortran modules for hipFFT and hipFFTW Add fortran/hipfft.F90 and fortran/hipfftw.F90, the hipfft and hipfftw modules generated from the C headers by the rocm-fortran generator under RFC0019 (ROCm/TheRock#8122). They are committed next to the headers, are not edited by hand, and .gitattributes marks them linguist-generated. --- projects/hipfft/.gitattributes | 3 + projects/hipfft/fortran/hipfft.F90 | 2206 +++++++++++++++++++++++++++ projects/hipfft/fortran/hipfftw.F90 | 1024 +++++++++++++ 3 files changed, 3233 insertions(+) create mode 100644 projects/hipfft/.gitattributes create mode 100644 projects/hipfft/fortran/hipfft.F90 create mode 100644 projects/hipfft/fortran/hipfftw.F90 diff --git a/projects/hipfft/.gitattributes b/projects/hipfft/.gitattributes new file mode 100644 index 000000000000..bc7b43f0e898 --- /dev/null +++ b/projects/hipfft/.gitattributes @@ -0,0 +1,3 @@ +# Generated by the rocm-fortran generator +/fortran/hipfft.F90 linguist-generated=true +/fortran/hipfftw.F90 linguist-generated=true diff --git a/projects/hipfft/fortran/hipfft.F90 b/projects/hipfft/fortran/hipfft.F90 new file mode 100644 index 000000000000..96adc8d7d926 --- /dev/null +++ b/projects/hipfft/fortran/hipfft.F90 @@ -0,0 +1,2206 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module hipfft + use, intrinsic :: iso_c_binding + implicit none + + ! hipfftResult_t + enum, bind(c) + enumerator :: HIPFFT_SUCCESS = 0 + enumerator :: HIPFFT_INVALID_PLAN = 1 + enumerator :: HIPFFT_ALLOC_FAILED = 2 + enumerator :: HIPFFT_INVALID_TYPE = 3 + enumerator :: HIPFFT_INVALID_VALUE = 4 + enumerator :: HIPFFT_INTERNAL_ERROR = 5 + enumerator :: HIPFFT_EXEC_FAILED = 6 + enumerator :: HIPFFT_SETUP_FAILED = 7 + enumerator :: HIPFFT_INVALID_SIZE = 8 + enumerator :: HIPFFT_UNALIGNED_DATA = 9 + enumerator :: HIPFFT_INCOMPLETE_PARAMETER_LIST = 10 + enumerator :: HIPFFT_INVALID_DEVICE = 11 + enumerator :: HIPFFT_PARSE_ERROR = 12 + enumerator :: HIPFFT_NO_WORKSPACE = 13 + enumerator :: HIPFFT_NOT_IMPLEMENTED = 14 + enumerator :: HIPFFT_NOT_SUPPORTED = 16 + end enum + + ! hipfftType_t + enum, bind(c) + enumerator :: HIPFFT_R2C = 42 + enumerator :: HIPFFT_C2R = 44 + enumerator :: HIPFFT_C2C = 41 + enumerator :: HIPFFT_D2Z = 106 + enumerator :: HIPFFT_Z2D = 108 + enumerator :: HIPFFT_Z2Z = 105 + end enum + + ! hipfftLibraryPropertyType_t + enum, bind(c) + enumerator :: HIPFFT_MAJOR_VERSION = 0 + enumerator :: HIPFFT_MINOR_VERSION = 1 + enumerator :: HIPFFT_PATCH_LEVEL = 2 + end enum + + ! hiplibFormat_t + enum, bind(c) + enumerator :: HIPLIB_FORMAT_HIPFFT = 0 + enumerator :: HIPLIB_FORMAT_UNDEFINED = 1 + end enum + + ! hipfftXtCopyType_t + enum, bind(c) + enumerator :: HIPFFT_COPY_HOST_TO_DEVICE = 0 + enumerator :: HIPFFT_COPY_DEVICE_TO_HOST = 1 + enumerator :: HIPFFT_COPY_DEVICE_TO_DEVICE = 2 + enumerator :: HIPFFT_COPY_UNDEFINED = 3 + end enum + + ! hipfftXtCallbackType_t + enum, bind(c) + enumerator :: HIPFFT_CB_LD_COMPLEX = 0 + enumerator :: HIPFFT_CB_LD_COMPLEX_DOUBLE = 1 + enumerator :: HIPFFT_CB_LD_REAL = 2 + enumerator :: HIPFFT_CB_LD_REAL_DOUBLE = 3 + enumerator :: HIPFFT_CB_ST_COMPLEX = 4 + enumerator :: HIPFFT_CB_ST_COMPLEX_DOUBLE = 5 + enumerator :: HIPFFT_CB_ST_REAL = 6 + enumerator :: HIPFFT_CB_ST_REAL_DOUBLE = 7 + enumerator :: HIPFFT_CB_UNDEFINED = 8 + end enum + + ! hipfftXtSubFormat_t + enum, bind(c) + enumerator :: HIPFFT_XT_FORMAT_INPUT = 0 + enumerator :: HIPFFT_XT_FORMAT_OUTPUT = 1 + enumerator :: HIPFFT_XT_FORMAT_INPLACE = 2 + enumerator :: HIPFFT_XT_FORMAT_INPLACE_SHUFFLED = 3 + enumerator :: HIPFFT_XT_FORMAT_1D_INPUT_SHUFFLED = 4 + enumerator :: HIPFFT_FORMAT_UNDEFINED = 5 + end enum + + ! hipfftMpCommType_t + enum, bind(c) + enumerator :: HIPFFT_COMM_MPI = 0 + enumerator :: HIPFFT_COMM_NONE = 1 + end enum + + integer(c_int), parameter :: hipfftVersionMajor = 1 + integer(c_int), parameter :: hipfftVersionMinor = 0 + integer(c_int), parameter :: hipfftVersionPatch = 27 + integer(c_int), parameter :: HIPFFT_FORWARD = -1 + integer(c_int), parameter :: HIPFFT_BACKWARD = 1 + integer(c_int), parameter :: MAX_HIP_DESCRIPTOR_GPUS = 64 + + + type, bind(c) :: hipXtDesc + integer(c_int) :: version + integer(c_int) :: nGPUs + integer(c_int) :: GPUs(64) + type(c_ptr) :: data(64) + integer(c_size_t) :: size(64) + type(c_ptr) :: hipXtState + end type hipXtDesc + + type, bind(c) :: hipLibXtDesc + integer(c_int) :: version + type(c_ptr) :: descriptor + integer(c_int) :: library + integer(c_int) :: subFormat + type(c_ptr) :: libDescriptor + end type hipLibXtDesc + + + interface hipfftPlan1d + function hipfftPlan1d_(plan,nx,myType,batch) bind(c, name="hipfftPlan1d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftPlan1d_ + type(c_ptr) :: plan + integer(c_int),value :: nx + integer(c_int),value :: myType + integer(c_int),value :: batch + end function + end interface + + interface hipfftPlan2d + function hipfftPlan2d_(plan,nx,ny,myType) bind(c, name="hipfftPlan2d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftPlan2d_ + type(c_ptr) :: plan + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: myType + end function + end interface + + interface hipfftPlan3d + function hipfftPlan3d_(plan,nx,ny,nz,myType) bind(c, name="hipfftPlan3d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftPlan3d_ + type(c_ptr) :: plan + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: nz + integer(c_int),value :: myType + end function + end interface + + interface hipfftPlanMany + function hipfftPlanMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType,batch) & + bind(c, name="hipfftPlanMany") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftPlanMany_ + type(c_ptr) :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: myType + integer(c_int),value :: batch + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftPlanMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftPlanMany_rank_0,& + hipfftPlanMany_rank_1 +#endif +#endif + end interface + + interface hipfftCreate + function hipfftCreate_(plan) bind(c, name="hipfftCreate") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftCreate_ + type(c_ptr) :: plan + end function + end interface + + interface hipfftExtPlanScaleFactor + function hipfftExtPlanScaleFactor_(plan,scalefactor) bind(c, name="hipfftExtPlanScaleFactor") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExtPlanScaleFactor_ + type(c_ptr),value :: plan + real(c_double),value :: scalefactor + end function + end interface + + interface hipfftMakePlan1d + function hipfftMakePlan1d_(plan,nx,myType,batch,workSize) bind(c, name="hipfftMakePlan1d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftMakePlan1d_ + type(c_ptr),value :: plan + integer(c_int),value :: nx + integer(c_int),value :: myType + integer(c_int),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftMakePlan1d_typed + end interface + + interface hipfftMakePlan2d + function hipfftMakePlan2d_(plan,nx,ny,myType,workSize) bind(c, name="hipfftMakePlan2d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftMakePlan2d_ + type(c_ptr),value :: plan + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: myType + type(c_ptr),value :: workSize + end function + + module procedure hipfftMakePlan2d_typed + end interface + + interface hipfftMakePlan3d + function hipfftMakePlan3d_(plan,nx,ny,nz,myType,workSize) bind(c, name="hipfftMakePlan3d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftMakePlan3d_ + type(c_ptr),value :: plan + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: nz + integer(c_int),value :: myType + type(c_ptr),value :: workSize + end function + + module procedure hipfftMakePlan3d_typed + end interface + + interface hipfftMakePlanMany + function hipfftMakePlanMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) & + bind(c, name="hipfftMakePlanMany") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftMakePlanMany_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: myType + integer(c_int),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftMakePlanMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftMakePlanMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftMakePlanMany_rank_0,& + hipfftMakePlanMany_rank_1 +#endif +#endif + end interface + + interface hipfftMakePlanMany64 + function hipfftMakePlanMany64_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) & + bind(c, name="hipfftMakePlanMany64") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftMakePlanMany64_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int64_t),value :: istride + integer(c_int64_t),value :: idist + type(c_ptr),value :: onembed + integer(c_int64_t),value :: ostride + integer(c_int64_t),value :: odist + integer(c_int),value :: myType + integer(c_int64_t),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftMakePlanMany64_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftMakePlanMany64_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftMakePlanMany64_rank_0,& + hipfftMakePlanMany64_rank_1 +#endif +#endif + end interface + + interface hipfftEstimate1d + function hipfftEstimate1d_(nx,myType,batch,workSize) bind(c, name="hipfftEstimate1d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftEstimate1d_ + integer(c_int),value :: nx + integer(c_int),value :: myType + integer(c_int),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftEstimate1d_typed + end interface + + interface hipfftEstimate2d + function hipfftEstimate2d_(nx,ny,myType,workSize) bind(c, name="hipfftEstimate2d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftEstimate2d_ + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: myType + type(c_ptr),value :: workSize + end function + + module procedure hipfftEstimate2d_typed + end interface + + interface hipfftEstimate3d + function hipfftEstimate3d_(nx,ny,nz,myType,workSize) bind(c, name="hipfftEstimate3d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftEstimate3d_ + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: nz + integer(c_int),value :: myType + type(c_ptr),value :: workSize + end function + + module procedure hipfftEstimate3d_typed + end interface + + interface hipfftEstimateMany + function hipfftEstimateMany_(rank,n,inembed,istride,idist,onembed,ostride,odist,myType,batch, & + workSize) & + bind(c, name="hipfftEstimateMany") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftEstimateMany_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: myType + integer(c_int),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftEstimateMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftEstimateMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftEstimateMany_rank_0,& + hipfftEstimateMany_rank_1 +#endif +#endif + end interface + + interface hipfftGetSize1d + function hipfftGetSize1d_(plan,nx,myType,batch,workSize) bind(c, name="hipfftGetSize1d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetSize1d_ + type(c_ptr),value :: plan + integer(c_int),value :: nx + integer(c_int),value :: myType + integer(c_int),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftGetSize1d_typed + end interface + + interface hipfftGetSize2d + function hipfftGetSize2d_(plan,nx,ny,myType,workSize) bind(c, name="hipfftGetSize2d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetSize2d_ + type(c_ptr),value :: plan + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: myType + type(c_ptr),value :: workSize + end function + + module procedure hipfftGetSize2d_typed + end interface + + interface hipfftGetSize3d + function hipfftGetSize3d_(plan,nx,ny,nz,myType,workSize) bind(c, name="hipfftGetSize3d") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetSize3d_ + type(c_ptr),value :: plan + integer(c_int),value :: nx + integer(c_int),value :: ny + integer(c_int),value :: nz + integer(c_int),value :: myType + type(c_ptr),value :: workSize + end function + + module procedure hipfftGetSize3d_typed + end interface + + interface hipfftGetSizeMany + function hipfftGetSizeMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) & + bind(c, name="hipfftGetSizeMany") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetSizeMany_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: myType + integer(c_int),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftGetSizeMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftGetSizeMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftGetSizeMany_rank_0,& + hipfftGetSizeMany_rank_1 +#endif +#endif + end interface + + interface hipfftGetSizeMany64 + function hipfftGetSizeMany64_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) & + bind(c, name="hipfftGetSizeMany64") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetSizeMany64_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int64_t),value :: istride + integer(c_int64_t),value :: idist + type(c_ptr),value :: onembed + integer(c_int64_t),value :: ostride + integer(c_int64_t),value :: odist + integer(c_int),value :: myType + integer(c_int64_t),value :: batch + type(c_ptr),value :: workSize + end function + + module procedure hipfftGetSizeMany64_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftGetSizeMany64_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftGetSizeMany64_rank_0,& + hipfftGetSizeMany64_rank_1 +#endif +#endif + end interface + + interface hipfftGetSize + function hipfftGetSize_(plan,workSize) bind(c, name="hipfftGetSize") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetSize_ + type(c_ptr),value :: plan + type(c_ptr),value :: workSize + end function + + module procedure hipfftGetSize_typed + end interface + + interface hipfftSetAutoAllocation + function hipfftSetAutoAllocation_(plan,autoAllocate) bind(c, name="hipfftSetAutoAllocation") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftSetAutoAllocation_ + type(c_ptr),value :: plan + integer(c_int),value :: autoAllocate + end function + end interface + + interface hipfftSetWorkArea + function hipfftSetWorkArea_(plan,workArea) bind(c, name="hipfftSetWorkArea") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftSetWorkArea_ + type(c_ptr),value :: plan + type(c_ptr),value :: workArea + end function + end interface + + interface hipfftXtSetWorkArea + function hipfftXtSetWorkArea_(plan,workArea) bind(c, name="hipfftXtSetWorkArea") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetWorkArea_ + type(c_ptr),value :: plan + type(c_ptr) :: workArea + end function + end interface + + interface hipfftExecC2C + function hipfftExecC2C_(plan,idata,odata,direction) bind(c, name="hipfftExecC2C") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExecC2C_ + type(c_ptr),value :: plan + type(c_ptr),value :: idata + type(c_ptr),value :: odata + integer(c_int),value :: direction + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftExecC2C_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftExecC2C_rank_0,& + hipfftExecC2C_rank_1,& + hipfftExecC2C_rank_2,& + hipfftExecC2C_rank_3 +#endif +#endif + end interface + + interface hipfftExecR2C + function hipfftExecR2C_(plan,idata,odata) bind(c, name="hipfftExecR2C") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExecR2C_ + type(c_ptr),value :: plan + type(c_ptr),value :: idata + type(c_ptr),value :: odata + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftExecR2C_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftExecR2C_rank_0,& + hipfftExecR2C_rank_1,& + hipfftExecR2C_rank_2,& + hipfftExecR2C_rank_3 +#endif +#endif + end interface + + interface hipfftExecC2R + function hipfftExecC2R_(plan,idata,odata) bind(c, name="hipfftExecC2R") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExecC2R_ + type(c_ptr),value :: plan + type(c_ptr),value :: idata + type(c_ptr),value :: odata + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftExecC2R_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftExecC2R_rank_0,& + hipfftExecC2R_rank_1,& + hipfftExecC2R_rank_2,& + hipfftExecC2R_rank_3 +#endif +#endif + end interface + + interface hipfftExecZ2Z + function hipfftExecZ2Z_(plan,idata,odata,direction) bind(c, name="hipfftExecZ2Z") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExecZ2Z_ + type(c_ptr),value :: plan + type(c_ptr),value :: idata + type(c_ptr),value :: odata + integer(c_int),value :: direction + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftExecZ2Z_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftExecZ2Z_rank_0,& + hipfftExecZ2Z_rank_1,& + hipfftExecZ2Z_rank_2,& + hipfftExecZ2Z_rank_3 +#endif +#endif + end interface + + interface hipfftExecD2Z + function hipfftExecD2Z_(plan,idata,odata) bind(c, name="hipfftExecD2Z") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExecD2Z_ + type(c_ptr),value :: plan + type(c_ptr),value :: idata + type(c_ptr),value :: odata + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftExecD2Z_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftExecD2Z_rank_0,& + hipfftExecD2Z_rank_1,& + hipfftExecD2Z_rank_2,& + hipfftExecD2Z_rank_3 +#endif +#endif + end interface + + interface hipfftExecZ2D + function hipfftExecZ2D_(plan,idata,odata) bind(c, name="hipfftExecZ2D") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftExecZ2D_ + type(c_ptr),value :: plan + type(c_ptr),value :: idata + type(c_ptr),value :: odata + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftExecZ2D_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftExecZ2D_rank_0,& + hipfftExecZ2D_rank_1,& + hipfftExecZ2D_rank_2,& + hipfftExecZ2D_rank_3 +#endif +#endif + end interface + + interface hipfftSetStream + function hipfftSetStream_(plan,stream) bind(c, name="hipfftSetStream") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftSetStream_ + type(c_ptr),value :: plan + type(c_ptr),value :: stream + end function + end interface + + interface hipfftDestroy + function hipfftDestroy_(plan) bind(c, name="hipfftDestroy") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftDestroy_ + type(c_ptr),value :: plan + end function + end interface + + interface hipfftGetVersion + function hipfftGetVersion_(version) bind(c, name="hipfftGetVersion") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetVersion_ + type(c_ptr),value :: version + end function + + module procedure hipfftGetVersion_typed + end interface + + interface hipfftGetProperty + function hipfftGetProperty_(myType,myValue) bind(c, name="hipfftGetProperty") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftGetProperty_ + integer(c_int),value :: myType + type(c_ptr),value :: myValue + end function + + module procedure hipfftGetProperty_typed + end interface + + interface hipfftXtSetCallback + function hipfftXtSetCallback_(plan,callbacks,cbtype,callbackData) & + bind(c, name="hipfftXtSetCallback") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetCallback_ + type(c_ptr),value :: plan + type(c_ptr) :: callbacks + integer(c_int),value :: cbtype + type(c_ptr) :: callbackData + end function + end interface + + interface hipfftXtClearCallback + function hipfftXtClearCallback_(plan,cbtype) bind(c, name="hipfftXtClearCallback") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtClearCallback_ + type(c_ptr),value :: plan + integer(c_int),value :: cbtype + end function + end interface + + interface hipfftXtSetCallbackSharedSize + function hipfftXtSetCallbackSharedSize_(plan,cbtype,sharedSize) & + bind(c, name="hipfftXtSetCallbackSharedSize") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetCallbackSharedSize_ + type(c_ptr),value :: plan + integer(c_int),value :: cbtype + integer(c_size_t),value :: sharedSize + end function + end interface + + interface hipfftXtSetJITCallback + function hipfftXtSetJITCallback_(plan,symbol_name,bitcode_data,bitcode_len_bytes,cbtype, & + cbdata) & + bind(c, name="hipfftXtSetJITCallback") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetJITCallback_ + type(c_ptr),value :: plan + type(c_ptr),value :: symbol_name + type(c_ptr),value :: bitcode_data + integer(c_size_t),value :: bitcode_len_bytes + integer(c_int),value :: cbtype + type(c_ptr) :: cbdata + end function + end interface + + interface hipfftXtMakePlanMany + function hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & + odist,outputType,batch,workSize,executionType) & + bind(c, name="hipfftXtMakePlanMany") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtMakePlanMany_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int64_t),value :: istride + integer(c_int64_t),value :: idist + integer(c_int),value :: inputType + type(c_ptr),value :: onembed + integer(c_int64_t),value :: ostride + integer(c_int64_t),value :: odist + integer(c_int),value :: outputType + integer(c_int64_t),value :: batch + type(c_ptr),value :: workSize + integer(c_int),value :: executionType + end function + + module procedure hipfftXtMakePlanMany_typed + end interface + + interface hipfftXtGetSizeMany + function hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & + odist,outputType,batch,workSize,executionType) & + bind(c, name="hipfftXtGetSizeMany") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtGetSizeMany_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int64_t),value :: istride + integer(c_int64_t),value :: idist + integer(c_int),value :: inputType + type(c_ptr),value :: onembed + integer(c_int64_t),value :: ostride + integer(c_int64_t),value :: odist + integer(c_int),value :: outputType + integer(c_int64_t),value :: batch + type(c_ptr),value :: workSize + integer(c_int),value :: executionType + end function + + module procedure hipfftXtGetSizeMany_typed + end interface + + interface hipfftXtExec + function hipfftXtExec_(plan,input,output,direction) bind(c, name="hipfftXtExec") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExec_ + type(c_ptr),value :: plan + type(c_ptr),value :: input + type(c_ptr),value :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftXtSetGPUs + function hipfftXtSetGPUs_(plan,count,gpus) bind(c, name="hipfftXtSetGPUs") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetGPUs_ + type(c_ptr),value :: plan + integer(c_int),value :: count + type(c_ptr),value :: gpus + end function + end interface + + interface hipfftXtMalloc + function hipfftXtMalloc_(plan,desc,myFormat) bind(c, name="hipfftXtMalloc") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtMalloc_ + type(c_ptr),value :: plan + type(c_ptr) :: desc + integer(c_int),value :: myFormat + end function + end interface + + interface hipfftXtMemcpy + function hipfftXtMemcpy_(plan,dest,src,myType) bind(c, name="hipfftXtMemcpy") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtMemcpy_ + type(c_ptr),value :: plan + type(c_ptr),value :: dest + type(c_ptr),value :: src + integer(c_int),value :: myType + end function + end interface + + interface hipfftXtFree + function hipfftXtFree_(desc) bind(c, name="hipfftXtFree") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtFree_ + type(hipLibXtDesc) :: desc + end function + end interface + + interface hipfftXtExecDescriptorC2C + function hipfftXtExecDescriptorC2C_(plan,input,output,direction) & + bind(c, name="hipfftXtExecDescriptorC2C") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorC2C_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftXtExecDescriptorR2C + function hipfftXtExecDescriptorR2C_(plan,input,output) bind(c, name="hipfftXtExecDescriptorR2C") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorR2C_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptorC2R + function hipfftXtExecDescriptorC2R_(plan,input,output) bind(c, name="hipfftXtExecDescriptorC2R") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorC2R_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptorZ2Z + function hipfftXtExecDescriptorZ2Z_(plan,input,output,direction) & + bind(c, name="hipfftXtExecDescriptorZ2Z") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorZ2Z_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftXtExecDescriptorD2Z + function hipfftXtExecDescriptorD2Z_(plan,input,output) bind(c, name="hipfftXtExecDescriptorD2Z") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorD2Z_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptorZ2D + function hipfftXtExecDescriptorZ2D_(plan,input,output) bind(c, name="hipfftXtExecDescriptorZ2D") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorZ2D_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptor + function hipfftXtExecDescriptor_(plan,input,output,direction) & + bind(c, name="hipfftXtExecDescriptor") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtExecDescriptor_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftMpAttachComm + function hipfftMpAttachComm_(plan,comm_type,comm_handle) bind(c, name="hipfftMpAttachComm") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftMpAttachComm_ + type(c_ptr),value :: plan + integer(c_int),value :: comm_type + type(c_ptr),value :: comm_handle + end function + end interface + + interface hipfftXtSetDistribution + function hipfftXtSetDistribution_(plan,rank,input_lower,input_upper,output_lower,output_upper, & + input_stride,output_stride) & + bind(c, name="hipfftXtSetDistribution") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetDistribution_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: input_lower + type(c_ptr),value :: input_upper + type(c_ptr),value :: output_lower + type(c_ptr),value :: output_upper + type(c_ptr),value :: input_stride + type(c_ptr),value :: output_stride + end function + end interface + + interface hipfftXtSetSubformatDefault + function hipfftXtSetSubformatDefault_(plan,subformat_forward,subformat_inverse) & + bind(c, name="hipfftXtSetSubformatDefault") + use iso_c_binding + import + implicit none + integer(c_int) :: hipfftXtSetSubformatDefault_ + type(c_ptr),value :: plan + integer(c_int),value :: subformat_forward + integer(c_int),value :: subformat_inverse + end function + end interface + + + contains + + subroutine hipfftCheck(status) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: status + character(len=:), allocatable :: name + if (status /= HIPFFT_SUCCESS) then + select case (status) + case (HIPFFT_INVALID_PLAN) + name = "HIPFFT_INVALID_PLAN" + case (HIPFFT_ALLOC_FAILED) + name = "HIPFFT_ALLOC_FAILED" + case (HIPFFT_INVALID_TYPE) + name = "HIPFFT_INVALID_TYPE" + case (HIPFFT_INVALID_VALUE) + name = "HIPFFT_INVALID_VALUE" + case (HIPFFT_INTERNAL_ERROR) + name = "HIPFFT_INTERNAL_ERROR" + case (HIPFFT_EXEC_FAILED) + name = "HIPFFT_EXEC_FAILED" + case (HIPFFT_SETUP_FAILED) + name = "HIPFFT_SETUP_FAILED" + case (HIPFFT_INVALID_SIZE) + name = "HIPFFT_INVALID_SIZE" + case (HIPFFT_UNALIGNED_DATA) + name = "HIPFFT_UNALIGNED_DATA" + case (HIPFFT_INCOMPLETE_PARAMETER_LIST) + name = "HIPFFT_INCOMPLETE_PARAMETER_LIST" + case (HIPFFT_INVALID_DEVICE) + name = "HIPFFT_INVALID_DEVICE" + case (HIPFFT_PARSE_ERROR) + name = "HIPFFT_PARSE_ERROR" + case (HIPFFT_NO_WORKSPACE) + name = "HIPFFT_NO_WORKSPACE" + case (HIPFFT_NOT_IMPLEMENTED) + name = "HIPFFT_NOT_IMPLEMENTED" + case (HIPFFT_NOT_SUPPORTED) + name = "HIPFFT_NOT_SUPPORTED" + case default + name = "unknown status" + end select + write (*, "(a,i0,a)") "HIPFFT ERROR: " // name // " (code ", status, ")" + stop 1 + end if + end subroutine hipfftCheck + function hipfftMakePlan1d_typed(plan,nx,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlan1d_typed + type(c_ptr), value :: plan + integer(c_int) :: nx + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlan1d_typed = hipfftMakePlan1d_(plan,nx,myType,batch,c_loc(workSize)) + end function + + function hipfftMakePlan2d_typed(plan,nx,ny,myType,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlan2d_typed + type(c_ptr), value :: plan + integer(c_int) :: nx + integer(c_int) :: ny + integer(kind(HIPFFT_R2C)) :: myType + integer(c_size_t),target :: workSize + ! + hipfftMakePlan2d_typed = hipfftMakePlan2d_(plan,nx,ny,myType,c_loc(workSize)) + end function + + function hipfftMakePlan3d_typed(plan,nx,ny,nz,myType,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlan3d_typed + type(c_ptr), value :: plan + integer(c_int) :: nx + integer(c_int) :: ny + integer(c_int) :: nz + integer(kind(HIPFFT_R2C)) :: myType + integer(c_size_t),target :: workSize + ! + hipfftMakePlan3d_typed = hipfftMakePlan3d_(plan,nx,ny,nz,myType,c_loc(workSize)) + end function + + function hipfftMakePlanMany_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany_typed = hipfftMakePlanMany_(plan,rank,n,inembed,istride,idist,onembed, & + ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftMakePlanMany64_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + type(c_ptr) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany64_typed = hipfftMakePlanMany64_(plan,rank,n,inembed,istride,idist, & + onembed,ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftEstimate1d_typed(nx,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimate1d_typed + integer(c_int) :: nx + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftEstimate1d_typed = hipfftEstimate1d_(nx,myType,batch,c_loc(workSize)) + end function + + function hipfftEstimate2d_typed(nx,ny,myType,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimate2d_typed + integer(c_int) :: nx + integer(c_int) :: ny + integer(kind(HIPFFT_R2C)) :: myType + integer(c_size_t),target :: workSize + ! + hipfftEstimate2d_typed = hipfftEstimate2d_(nx,ny,myType,c_loc(workSize)) + end function + + function hipfftEstimate3d_typed(nx,ny,nz,myType,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimate3d_typed + integer(c_int) :: nx + integer(c_int) :: ny + integer(c_int) :: nz + integer(kind(HIPFFT_R2C)) :: myType + integer(c_size_t),target :: workSize + ! + hipfftEstimate3d_typed = hipfftEstimate3d_(nx,ny,nz,myType,c_loc(workSize)) + end function + + function hipfftEstimateMany_typed(rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_typed + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftEstimateMany_typed = hipfftEstimateMany_(rank,n,inembed,istride,idist,onembed,ostride, & + odist,myType,batch,c_loc(workSize)) + end function + + function hipfftGetSize1d_typed(plan,nx,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize1d_typed + type(c_ptr), value :: plan + integer(c_int) :: nx + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSize1d_typed = hipfftGetSize1d_(plan,nx,myType,batch,c_loc(workSize)) + end function + + function hipfftGetSize2d_typed(plan,nx,ny,myType,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize2d_typed + type(c_ptr), value :: plan + integer(c_int) :: nx + integer(c_int) :: ny + integer(kind(HIPFFT_R2C)) :: myType + integer(c_size_t),target :: workSize + ! + hipfftGetSize2d_typed = hipfftGetSize2d_(plan,nx,ny,myType,c_loc(workSize)) + end function + + function hipfftGetSize3d_typed(plan,nx,ny,nz,myType,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize3d_typed + type(c_ptr), value :: plan + integer(c_int) :: nx + integer(c_int) :: ny + integer(c_int) :: nz + integer(kind(HIPFFT_R2C)) :: myType + integer(c_size_t),target :: workSize + ! + hipfftGetSize3d_typed = hipfftGetSize3d_(plan,nx,ny,nz,myType,c_loc(workSize)) + end function + + function hipfftGetSizeMany_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany_typed = hipfftGetSizeMany_(plan,rank,n,inembed,istride,idist,onembed, & + ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftGetSizeMany64_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + type(c_ptr) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany64_typed = hipfftGetSizeMany64_(plan,rank,n,inembed,istride,idist,onembed, & + ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftGetSize_typed(plan,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize_typed + type(c_ptr), value :: plan + integer(c_size_t),target :: workSize + ! + hipfftGetSize_typed = hipfftGetSize_(plan,c_loc(workSize)) + end function + + function hipfftGetVersion_typed(version) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetVersion_typed + integer(c_int),target :: version + ! + hipfftGetVersion_typed = hipfftGetVersion_(c_loc(version)) + end function + + function hipfftGetProperty_typed(myType,myValue) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetProperty_typed + integer(kind(HIPFFT_MAJOR_VERSION)) :: myType + integer(c_int),target :: myValue + ! + hipfftGetProperty_typed = hipfftGetProperty_(myType,c_loc(myValue)) + end function + + function hipfftXtMakePlanMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + type(c_ptr) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_typed = hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist, & + inputType,onembed,ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + + function hipfftXtGetSizeMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + type(c_ptr) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_typed = hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist, & + inputType,onembed,ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + + +#if defined(USE_ASSUMED_SHAPE) || defined(USE_ASSUMED_RANK) + +#ifdef USE_ASSUMED_RANK + function hipfftPlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftPlanMany_assumed_rank + type(c_ptr) :: plan + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + ! + hipfftPlanMany_assumed_rank = hipfftPlanMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch) + end function + +#else + function hipfftPlanMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftPlanMany_rank_0 + type(c_ptr) :: plan + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + ! + hipfftPlanMany_rank_0 = hipfftPlanMany_(plan,rank,c_loc(n),c_loc(inembed),istride,idist, & + c_loc(onembed),ostride,odist,myType,batch) + end function + + function hipfftPlanMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftPlanMany_rank_1 + type(c_ptr) :: plan + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + ! + hipfftPlanMany_rank_1 = hipfftPlanMany_(plan,rank,c_loc(n),c_loc(inembed),istride,idist, & + c_loc(onembed),ostride,odist,myType,batch) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftMakePlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & + odist,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany_assumed_rank = hipfftMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#else + function hipfftMakePlanMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany_rank_0 = hipfftMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftMakePlanMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany_rank_1 = hipfftMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftMakePlanMany64_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & + odist,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(..) :: n + integer(c_int64_t),target,dimension(..) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int64_t),target,dimension(..) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany64_assumed_rank = hipfftMakePlanMany64_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#else + function hipfftMakePlanMany64_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target :: n + integer(c_int64_t),target :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int64_t),target :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany64_rank_0 = hipfftMakePlanMany64_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftMakePlanMany64_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(:) :: n + integer(c_int64_t),target,dimension(:) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int64_t),target,dimension(:) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftMakePlanMany64_rank_1 = hipfftMakePlanMany64_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftEstimateMany_assumed_rank(rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftEstimateMany_assumed_rank = hipfftEstimateMany_(rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#else + function hipfftEstimateMany_rank_0(rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftEstimateMany_rank_0 = hipfftEstimateMany_(rank,c_loc(n),c_loc(inembed),istride,idist, & + c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftEstimateMany_rank_1(rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & + batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftEstimateMany_rank_1 = hipfftEstimateMany_(rank,c_loc(n),c_loc(inembed),istride,idist, & + c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftGetSizeMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & + odist,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany_assumed_rank = hipfftGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#else + function hipfftGetSizeMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany_rank_0 = hipfftGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftGetSizeMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany_rank_1 = hipfftGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftGetSizeMany64_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & + odist,myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(..) :: n + integer(c_int64_t),target,dimension(..) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int64_t),target,dimension(..) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany64_assumed_rank = hipfftGetSizeMany64_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#else + function hipfftGetSizeMany64_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target :: n + integer(c_int64_t),target :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int64_t),target :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany64_rank_0 = hipfftGetSizeMany64_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + + function hipfftGetSizeMany64_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & + myType,batch,workSize) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(:) :: n + integer(c_int64_t),target,dimension(:) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int64_t),target,dimension(:) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(kind(HIPFFT_R2C)) :: myType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + ! + hipfftGetSizeMany64_rank_1 = hipfftGetSizeMany64_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,c_loc(onembed),ostride,odist,myType,batch,c_loc(workSize)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftExecC2C_assumed_rank(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_assumed_rank + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(..) :: idata + complex(c_float_complex),target,dimension(..) :: odata + integer(c_int) :: direction + ! + hipfftExecC2C_assumed_rank = hipfftExecC2C_(plan,c_loc(idata),c_loc(odata),direction) + end function + +#else + function hipfftExecC2C_rank_0(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_0 + type(c_ptr), value :: plan + complex(c_float_complex),target :: idata + complex(c_float_complex),target :: odata + integer(c_int) :: direction + ! + hipfftExecC2C_rank_0 = hipfftExecC2C_(plan,c_loc(idata),c_loc(odata),direction) + end function + + function hipfftExecC2C_rank_1(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_1 + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(:) :: idata + complex(c_float_complex),target,dimension(:) :: odata + integer(c_int) :: direction + ! + hipfftExecC2C_rank_1 = hipfftExecC2C_(plan,c_loc(idata),c_loc(odata),direction) + end function + + function hipfftExecC2C_rank_2(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_2 + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(:,:) :: idata + complex(c_float_complex),target,dimension(:,:) :: odata + integer(c_int) :: direction + ! + hipfftExecC2C_rank_2 = hipfftExecC2C_(plan,c_loc(idata),c_loc(odata),direction) + end function + + function hipfftExecC2C_rank_3(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_3 + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(:,:,:) :: idata + complex(c_float_complex),target,dimension(:,:,:) :: odata + integer(c_int) :: direction + ! + hipfftExecC2C_rank_3 = hipfftExecC2C_(plan,c_loc(idata),c_loc(odata),direction) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftExecR2C_assumed_rank(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_assumed_rank + type(c_ptr), value :: plan + real(c_float),target,dimension(..) :: idata + complex(c_float_complex),target,dimension(..) :: odata + ! + hipfftExecR2C_assumed_rank = hipfftExecR2C_(plan,c_loc(idata),c_loc(odata)) + end function + +#else + function hipfftExecR2C_rank_0(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_0 + type(c_ptr), value :: plan + real(c_float),target :: idata + complex(c_float_complex),target :: odata + ! + hipfftExecR2C_rank_0 = hipfftExecR2C_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecR2C_rank_1(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_1 + type(c_ptr), value :: plan + real(c_float),target,dimension(:) :: idata + complex(c_float_complex),target,dimension(:) :: odata + ! + hipfftExecR2C_rank_1 = hipfftExecR2C_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecR2C_rank_2(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_2 + type(c_ptr), value :: plan + real(c_float),target,dimension(:,:) :: idata + complex(c_float_complex),target,dimension(:,:) :: odata + ! + hipfftExecR2C_rank_2 = hipfftExecR2C_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecR2C_rank_3(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_3 + type(c_ptr), value :: plan + real(c_float),target,dimension(:,:,:) :: idata + complex(c_float_complex),target,dimension(:,:,:) :: odata + ! + hipfftExecR2C_rank_3 = hipfftExecR2C_(plan,c_loc(idata),c_loc(odata)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftExecC2R_assumed_rank(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_assumed_rank + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(..) :: idata + real(c_float),target,dimension(..) :: odata + ! + hipfftExecC2R_assumed_rank = hipfftExecC2R_(plan,c_loc(idata),c_loc(odata)) + end function + +#else + function hipfftExecC2R_rank_0(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_0 + type(c_ptr), value :: plan + complex(c_float_complex),target :: idata + real(c_float),target :: odata + ! + hipfftExecC2R_rank_0 = hipfftExecC2R_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecC2R_rank_1(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_1 + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(:) :: idata + real(c_float),target,dimension(:) :: odata + ! + hipfftExecC2R_rank_1 = hipfftExecC2R_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecC2R_rank_2(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_2 + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(:,:) :: idata + real(c_float),target,dimension(:,:) :: odata + ! + hipfftExecC2R_rank_2 = hipfftExecC2R_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecC2R_rank_3(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_3 + type(c_ptr), value :: plan + complex(c_float_complex),target,dimension(:,:,:) :: idata + real(c_float),target,dimension(:,:,:) :: odata + ! + hipfftExecC2R_rank_3 = hipfftExecC2R_(plan,c_loc(idata),c_loc(odata)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftExecZ2Z_assumed_rank(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_assumed_rank + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(..) :: idata + complex(c_double_complex),target,dimension(..) :: odata + integer(c_int) :: direction + ! + hipfftExecZ2Z_assumed_rank = hipfftExecZ2Z_(plan,c_loc(idata),c_loc(odata),direction) + end function + +#else + function hipfftExecZ2Z_rank_0(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_0 + type(c_ptr), value :: plan + complex(c_double_complex),target :: idata + complex(c_double_complex),target :: odata + integer(c_int) :: direction + ! + hipfftExecZ2Z_rank_0 = hipfftExecZ2Z_(plan,c_loc(idata),c_loc(odata),direction) + end function + + function hipfftExecZ2Z_rank_1(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_1 + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(:) :: idata + complex(c_double_complex),target,dimension(:) :: odata + integer(c_int) :: direction + ! + hipfftExecZ2Z_rank_1 = hipfftExecZ2Z_(plan,c_loc(idata),c_loc(odata),direction) + end function + + function hipfftExecZ2Z_rank_2(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_2 + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(:,:) :: idata + complex(c_double_complex),target,dimension(:,:) :: odata + integer(c_int) :: direction + ! + hipfftExecZ2Z_rank_2 = hipfftExecZ2Z_(plan,c_loc(idata),c_loc(odata),direction) + end function + + function hipfftExecZ2Z_rank_3(plan,idata,odata,direction) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_3 + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(:,:,:) :: idata + complex(c_double_complex),target,dimension(:,:,:) :: odata + integer(c_int) :: direction + ! + hipfftExecZ2Z_rank_3 = hipfftExecZ2Z_(plan,c_loc(idata),c_loc(odata),direction) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftExecD2Z_assumed_rank(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_assumed_rank + type(c_ptr), value :: plan + real(c_double),target,dimension(..) :: idata + complex(c_double_complex),target,dimension(..) :: odata + ! + hipfftExecD2Z_assumed_rank = hipfftExecD2Z_(plan,c_loc(idata),c_loc(odata)) + end function + +#else + function hipfftExecD2Z_rank_0(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_0 + type(c_ptr), value :: plan + real(c_double),target :: idata + complex(c_double_complex),target :: odata + ! + hipfftExecD2Z_rank_0 = hipfftExecD2Z_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecD2Z_rank_1(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_1 + type(c_ptr), value :: plan + real(c_double),target,dimension(:) :: idata + complex(c_double_complex),target,dimension(:) :: odata + ! + hipfftExecD2Z_rank_1 = hipfftExecD2Z_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecD2Z_rank_2(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_2 + type(c_ptr), value :: plan + real(c_double),target,dimension(:,:) :: idata + complex(c_double_complex),target,dimension(:,:) :: odata + ! + hipfftExecD2Z_rank_2 = hipfftExecD2Z_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecD2Z_rank_3(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_3 + type(c_ptr), value :: plan + real(c_double),target,dimension(:,:,:) :: idata + complex(c_double_complex),target,dimension(:,:,:) :: odata + ! + hipfftExecD2Z_rank_3 = hipfftExecD2Z_(plan,c_loc(idata),c_loc(odata)) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftExecZ2D_assumed_rank(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_assumed_rank + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(..) :: idata + real(c_double),target,dimension(..) :: odata + ! + hipfftExecZ2D_assumed_rank = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) + end function + +#else + function hipfftExecZ2D_rank_0(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_0 + type(c_ptr), value :: plan + complex(c_double_complex),target :: idata + real(c_double),target :: odata + ! + hipfftExecZ2D_rank_0 = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecZ2D_rank_1(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_1 + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(:) :: idata + real(c_double),target,dimension(:) :: odata + ! + hipfftExecZ2D_rank_1 = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecZ2D_rank_2(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_2 + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(:,:) :: idata + real(c_double),target,dimension(:,:) :: odata + ! + hipfftExecZ2D_rank_2 = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) + end function + + function hipfftExecZ2D_rank_3(plan,idata,odata) + use iso_c_binding + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_3 + type(c_ptr), value :: plan + complex(c_double_complex),target,dimension(:,:,:) :: idata + real(c_double),target,dimension(:,:,:) :: odata + ! + hipfftExecZ2D_rank_3 = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) + end function + +#endif +#endif +end module hipfft diff --git a/projects/hipfft/fortran/hipfftw.F90 b/projects/hipfft/fortran/hipfftw.F90 new file mode 100644 index 000000000000..cfb2c9baa7f9 --- /dev/null +++ b/projects/hipfft/fortran/hipfftw.F90 @@ -0,0 +1,1024 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module hipfftw + use, intrinsic :: iso_c_binding + implicit none + + integer(c_int), parameter :: FFTW_MEASURE = 0 + integer(c_int), parameter :: FFTW_DESTROY_INPUT = 1 + integer(c_int), parameter :: FFTW_UNALIGNED = 2 + integer(c_int), parameter :: FFTW_CONSERVE_MEMORY = 4 + integer(c_int), parameter :: FFTW_EXHAUSTIVE = 8 + integer(c_int), parameter :: FFTW_PRESERVE_INPUT = 16 + integer(c_int), parameter :: FFTW_PATIENT = 32 + integer(c_int), parameter :: FFTW_ESTIMATE = 64 + integer(c_int), parameter :: FFTW_WISDOM_ONLY = 2097152 + integer(c_int), parameter :: FFTW_FORWARD = -1 + integer(c_int), parameter :: FFTW_BACKWARD = 1 + + + type, bind(c) :: fftw_iodim + integer(c_int) :: n + integer(c_int) :: is + integer(c_int) :: os + end type fftw_iodim + + type, bind(c) :: fftw_iodim64 + integer(c_intptr_t) :: n + integer(c_intptr_t) :: is + integer(c_intptr_t) :: os + end type fftw_iodim64 + + + interface fftw_malloc + function fftw_malloc_(n) bind(c, name="fftw_malloc") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_malloc_ + integer(c_size_t),value :: n + end function + end interface + + interface fftwf_malloc + function fftwf_malloc_(n) bind(c, name="fftwf_malloc") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_malloc_ + integer(c_size_t),value :: n + end function + end interface + + interface fftw_alloc_real + function fftw_alloc_real_(n) bind(c, name="fftw_alloc_real") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_alloc_real_ + integer(c_size_t),value :: n + end function + end interface + + interface fftwf_alloc_real + function fftwf_alloc_real_(n) bind(c, name="fftwf_alloc_real") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_alloc_real_ + integer(c_size_t),value :: n + end function + end interface + + interface fftw_alloc_complex + function fftw_alloc_complex_(n) bind(c, name="fftw_alloc_complex") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_alloc_complex_ + integer(c_size_t),value :: n + end function + end interface + + interface fftwf_alloc_complex + function fftwf_alloc_complex_(n) bind(c, name="fftwf_alloc_complex") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_alloc_complex_ + integer(c_size_t),value :: n + end function + end interface + + interface fftw_free + subroutine fftw_free_(p) bind(c, name="fftw_free") + use iso_c_binding + import + implicit none + type(c_ptr),value :: p + end subroutine + end interface + + interface fftwf_free + subroutine fftwf_free_(p) bind(c, name="fftwf_free") + use iso_c_binding + import + implicit none + type(c_ptr),value :: p + end subroutine + end interface + + interface fftw_plan_dft_1d + function fftw_plan_dft_1d_(n,in,out,sign,flags) bind(c, name="fftw_plan_dft_1d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_1d_ + integer(c_int),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_1d + function fftwf_plan_dft_1d_(n,in,out,sign,flags) bind(c, name="fftwf_plan_dft_1d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_1d_ + integer(c_int),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_2d + function fftw_plan_dft_2d_(n0,n1,in,out,sign,flags) bind(c, name="fftw_plan_dft_2d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_2d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_2d + function fftwf_plan_dft_2d_(n0,n1,in,out,sign,flags) bind(c, name="fftwf_plan_dft_2d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_2d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_3d + function fftw_plan_dft_3d_(n0,n1,n2,in,out,sign,flags) bind(c, name="fftw_plan_dft_3d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_3d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + integer(c_int),value :: n2 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_3d + function fftwf_plan_dft_3d_(n0,n1,n2,in,out,sign,flags) bind(c, name="fftwf_plan_dft_3d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_3d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + integer(c_int),value :: n2 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft + function fftw_plan_dft_(rank,n,in,out,sign,flags) bind(c, name="fftw_plan_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft + function fftwf_plan_dft_(rank,n,in,out,sign,flags) bind(c, name="fftwf_plan_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_r2c_1d + function fftw_plan_dft_r2c_1d_(n,in,out,flags) bind(c, name="fftw_plan_dft_r2c_1d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_1d_ + integer(c_int),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_r2c_1d + function fftwf_plan_dft_r2c_1d_(n,in,out,flags) bind(c, name="fftwf_plan_dft_r2c_1d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_1d_ + integer(c_int),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_r2c_2d + function fftw_plan_dft_r2c_2d_(n0,n1,in,out,flags) bind(c, name="fftw_plan_dft_r2c_2d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_2d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_r2c_2d + function fftwf_plan_dft_r2c_2d_(n0,n1,in,out,flags) bind(c, name="fftwf_plan_dft_r2c_2d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_2d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_r2c_3d + function fftw_plan_dft_r2c_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftw_plan_dft_r2c_3d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_3d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + integer(c_int),value :: n2 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_r2c_3d + function fftwf_plan_dft_r2c_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftwf_plan_dft_r2c_3d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_3d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + integer(c_int),value :: n2 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_r2c + function fftw_plan_dft_r2c_(rank,n,in,out,flags) bind(c, name="fftw_plan_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_r2c + function fftwf_plan_dft_r2c_(rank,n,in,out,flags) bind(c, name="fftwf_plan_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_c2r_1d + function fftw_plan_dft_c2r_1d_(n,in,out,flags) bind(c, name="fftw_plan_dft_c2r_1d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_1d_ + integer(c_int),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_c2r_1d + function fftwf_plan_dft_c2r_1d_(n,in,out,flags) bind(c, name="fftwf_plan_dft_c2r_1d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_1d_ + integer(c_int),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_c2r_2d + function fftw_plan_dft_c2r_2d_(n0,n1,in,out,flags) bind(c, name="fftw_plan_dft_c2r_2d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_2d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_c2r_2d + function fftwf_plan_dft_c2r_2d_(n0,n1,in,out,flags) bind(c, name="fftwf_plan_dft_c2r_2d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_2d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_c2r_3d + function fftw_plan_dft_c2r_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftw_plan_dft_c2r_3d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_3d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + integer(c_int),value :: n2 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_c2r_3d + function fftwf_plan_dft_c2r_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftwf_plan_dft_c2r_3d") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_3d_ + integer(c_int),value :: n0 + integer(c_int),value :: n1 + integer(c_int),value :: n2 + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_dft_c2r + function fftw_plan_dft_c2r_(rank,n,in,out,flags) bind(c, name="fftw_plan_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_dft_c2r + function fftwf_plan_dft_c2r_(rank,n,in,out,flags) bind(c, name="fftwf_plan_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_ + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_many_dft + function fftw_plan_many_dft_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & + odist,sign,flags) & + bind(c, name="fftw_plan_many_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_many_dft_ + integer(c_int),value :: rank + type(c_ptr),value :: n + integer(c_int),value :: howmany + type(c_ptr),value :: in + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: out + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_many_dft + function fftwf_plan_many_dft_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & + odist,sign,flags) & + bind(c, name="fftwf_plan_many_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_many_dft_ + integer(c_int),value :: rank + type(c_ptr),value :: n + integer(c_int),value :: howmany + type(c_ptr),value :: in + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: out + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_many_dft_r2c + function fftw_plan_many_dft_r2c_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & + odist,flags) & + bind(c, name="fftw_plan_many_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_many_dft_r2c_ + integer(c_int),value :: rank + type(c_ptr),value :: n + integer(c_int),value :: howmany + type(c_ptr),value :: in + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: out + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_many_dft_r2c + function fftwf_plan_many_dft_r2c_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & + odist,flags) & + bind(c, name="fftwf_plan_many_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_many_dft_r2c_ + integer(c_int),value :: rank + type(c_ptr),value :: n + integer(c_int),value :: howmany + type(c_ptr),value :: in + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: out + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_many_dft_c2r + function fftw_plan_many_dft_c2r_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & + odist,flags) & + bind(c, name="fftw_plan_many_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_many_dft_c2r_ + integer(c_int),value :: rank + type(c_ptr),value :: n + integer(c_int),value :: howmany + type(c_ptr),value :: in + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: out + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_many_dft_c2r + function fftwf_plan_many_dft_c2r_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & + odist,flags) & + bind(c, name="fftwf_plan_many_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_many_dft_c2r_ + integer(c_int),value :: rank + type(c_ptr),value :: n + integer(c_int),value :: howmany + type(c_ptr),value :: in + type(c_ptr),value :: inembed + integer(c_int),value :: istride + integer(c_int),value :: idist + type(c_ptr),value :: out + type(c_ptr),value :: onembed + integer(c_int),value :: ostride + integer(c_int),value :: odist + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_guru_dft + function fftw_plan_guru_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(c, name="fftw_plan_guru_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_guru_dft_ + integer(c_int),value :: rank + type(fftw_iodim) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_guru_dft + function fftwf_plan_guru_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(c, name="fftwf_plan_guru_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_ + integer(c_int),value :: rank + type(fftw_iodim) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_guru_dft_r2c + function fftw_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftw_plan_guru_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_guru_dft_r2c_ + integer(c_int),value :: rank + type(fftw_iodim) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_guru_dft_r2c + function fftwf_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftwf_plan_guru_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_r2c_ + integer(c_int),value :: rank + type(fftw_iodim) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_guru_dft_c2r + function fftw_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftw_plan_guru_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_guru_dft_c2r_ + integer(c_int),value :: rank + type(fftw_iodim) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_guru_dft_c2r + function fftwf_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftwf_plan_guru_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_c2r_ + integer(c_int),value :: rank + type(fftw_iodim) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_guru64_dft + function fftw_plan_guru64_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(c, name="fftw_plan_guru64_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_ + integer(c_int),value :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_guru64_dft + function fftwf_plan_guru64_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(c, name="fftwf_plan_guru64_dft") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_ + integer(c_int),value :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: sign + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_guru64_dft_r2c + function fftw_plan_guru64_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftw_plan_guru64_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_r2c_ + integer(c_int),value :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_guru64_dft_r2c + function fftwf_plan_guru64_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftwf_plan_guru64_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_r2c_ + integer(c_int),value :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_plan_guru64_dft_c2r + function fftw_plan_guru64_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftw_plan_guru64_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_c2r_ + integer(c_int),value :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftwf_plan_guru64_dft_c2r + function fftwf_plan_guru64_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(c, name="fftwf_plan_guru64_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_c2r_ + integer(c_int),value :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int),value :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr),value :: in + type(c_ptr),value :: out + integer(c_int),value :: flags + end function + end interface + + interface fftw_execute + subroutine fftw_execute_(plan) bind(c, name="fftw_execute") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + end subroutine + end interface + + interface fftwf_execute + subroutine fftwf_execute_(plan) bind(c, name="fftwf_execute") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + end subroutine + end interface + + interface fftw_execute_dft + subroutine fftw_execute_dft_(plan,in,out) bind(c, name="fftw_execute_dft") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + type(c_ptr),value :: in + type(c_ptr),value :: out + end subroutine + end interface + + interface fftwf_execute_dft + subroutine fftwf_execute_dft_(plan,in,out) bind(c, name="fftwf_execute_dft") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + type(c_ptr),value :: in + type(c_ptr),value :: out + end subroutine + end interface + + interface fftw_execute_dft_r2c + subroutine fftw_execute_dft_r2c_(plan,in,out) bind(c, name="fftw_execute_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + type(c_ptr),value :: in + type(c_ptr),value :: out + end subroutine + end interface + + interface fftwf_execute_dft_r2c + subroutine fftwf_execute_dft_r2c_(plan,in,out) bind(c, name="fftwf_execute_dft_r2c") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + type(c_ptr),value :: in + type(c_ptr),value :: out + end subroutine + end interface + + interface fftw_execute_dft_c2r + subroutine fftw_execute_dft_c2r_(plan,in,out) bind(c, name="fftw_execute_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + type(c_ptr),value :: in + type(c_ptr),value :: out + end subroutine + end interface + + interface fftwf_execute_dft_c2r + subroutine fftwf_execute_dft_c2r_(plan,in,out) bind(c, name="fftwf_execute_dft_c2r") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + type(c_ptr),value :: in + type(c_ptr),value :: out + end subroutine + end interface + + interface fftw_destroy_plan + subroutine fftw_destroy_plan_(plan) bind(c, name="fftw_destroy_plan") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + end subroutine + end interface + + interface fftwf_destroy_plan + subroutine fftwf_destroy_plan_(plan) bind(c, name="fftwf_destroy_plan") + use iso_c_binding + import + implicit none + type(c_ptr),value :: plan + end subroutine + end interface + + interface fftw_print_plan + subroutine fftw_print_plan_(arg1) bind(c, name="fftw_print_plan") + use iso_c_binding + import + implicit none + type(c_ptr),value :: arg1 + end subroutine + end interface + + interface fftwf_print_plan + subroutine fftwf_print_plan_(arg1) bind(c, name="fftwf_print_plan") + use iso_c_binding + import + implicit none + type(c_ptr),value :: arg1 + end subroutine + end interface + + interface fftw_set_timelimit + subroutine fftw_set_timelimit_(arg1) bind(c, name="fftw_set_timelimit") + use iso_c_binding + import + implicit none + real(c_double),value :: arg1 + end subroutine + end interface + + interface fftwf_set_timelimit + subroutine fftwf_set_timelimit_(arg1) bind(c, name="fftwf_set_timelimit") + use iso_c_binding + import + implicit none + real(c_double),value :: arg1 + end subroutine + end interface + + interface fftw_cost + function fftw_cost_(arg1) bind(c, name="fftw_cost") + use iso_c_binding + import + implicit none + real(c_double) :: fftw_cost_ + type(c_ptr),value :: arg1 + end function + end interface + + interface fftwf_cost + function fftwf_cost_(arg1) bind(c, name="fftwf_cost") + use iso_c_binding + import + implicit none + real(c_double) :: fftwf_cost_ + type(c_ptr),value :: arg1 + end function + end interface + + interface fftw_flops + subroutine fftw_flops_(arg1,arg2,arg3,arg4) bind(c, name="fftw_flops") + use iso_c_binding + import + implicit none + type(c_ptr),value :: arg1 + type(c_ptr),value :: arg2 + type(c_ptr),value :: arg3 + type(c_ptr),value :: arg4 + end subroutine + end interface + + interface fftwf_flops + subroutine fftwf_flops_(arg1,arg2,arg3,arg4) bind(c, name="fftwf_flops") + use iso_c_binding + import + implicit none + type(c_ptr),value :: arg1 + type(c_ptr),value :: arg2 + type(c_ptr),value :: arg3 + type(c_ptr),value :: arg4 + end subroutine + end interface + + interface fftw_cleanup + subroutine fftw_cleanup_() bind(c, name="fftw_cleanup") + use iso_c_binding + import + implicit none + end subroutine + end interface + + interface fftwf_cleanup + subroutine fftwf_cleanup_() bind(c, name="fftwf_cleanup") + use iso_c_binding + import + implicit none + end subroutine + end interface + +end module hipfftw From 9f54e863819f5803a58df100fb6a481287ce9ca9 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sun, 4 Oct 2026 22:59:14 -0600 Subject: [PATCH 02/12] feat(hipfft): add generated Fortran bindings for hipFFT and hipFFTW Build fortran/hipfft.F90 and fortran/hipfftw.F90 as hip::hipfft_fortran and hip::hipfftw_fortran from fortran/, a CMake project of its own that the root adds. BUILD_FORTRAN_BINDINGS (default ${UNIX}, OFF on the CUDA backend), BUILD_FORTRAN_CLIENTS (default ON) and FORTRAN_ARRAY_INTERFACES (default assumed-shape, hipfft only) control them, and HIPFFT_BUILD_FORTRAN_* and HIPFFTW_BUILD_FORTRAN_* override per binding. The .mod files and the archives install per compiler under /fortran/ and /fortran/, beside hipfft-fortran and hipfftw-fortran config packages. fortran/test/ adds 20 CTest tests labelled gpu; they use hip and skip until ROCm/rocm-systems#11923 lands. hipFFT had no Fortran module before, so nothing is removed. Refs: ROCm/TheRock#8122 (RFC0019) --- .github/CODEOWNERS | 1 + projects/hipfft/CHANGELOG.md | 14 + projects/hipfft/CMakeLists.txt | 16 +- ...building-installing-hipfft-and-hipfftw.rst | 6 + projects/hipfft/fortran/CMakeLists.txt | 476 ++++++++++++++++++ .../fortran/cmake/toolchains/amdflang.cmake | 30 ++ .../fortran/cmake/toolchains/cray.cmake | 30 ++ .../hipfft/fortran/cmake/toolchains/gnu.cmake | 30 ++ .../cmake/toolchains/intel-classic.cmake | 30 ++ .../fortran/cmake/toolchains/intel.cmake | 30 ++ .../fortran/cmake/toolchains/nvhpc.cmake | 30 ++ .../fortran/hipfft-fortran-config.cmake.in | 156 ++++++ .../fortran/hipfftw-fortran-config.cmake.in | 156 ++++++ projects/hipfft/fortran/test/CMakeLists.txt | 180 +++++++ projects/hipfft/fortran/test/hipfft.f03 | 104 ++++ projects/hipfft/fortran/test/hipfft.f08 | 88 ++++ .../fortran/test/hipfft_c2c_1d_batched_z.f03 | 102 ++++ .../fortran/test/hipfft_c2c_1d_batched_z.f08 | 106 ++++ .../hipfft/fortran/test/hipfft_c2c_1d_c.f03 | 90 ++++ .../hipfft/fortran/test/hipfft_c2c_1d_c.f08 | 85 ++++ .../hipfft/fortran/test/hipfft_c2c_1d_z.f03 | 90 ++++ .../hipfft/fortran/test/hipfft_c2c_1d_z.f08 | 85 ++++ .../hipfft/fortran/test/hipfft_c2c_2d_z.f03 | 91 ++++ .../hipfft/fortran/test/hipfft_c2c_2d_z.f08 | 86 ++++ .../hipfft/fortran/test/hipfft_c2c_3d_z.f03 | 91 ++++ .../hipfft/fortran/test/hipfft_c2c_3d_z.f08 | 86 ++++ .../test/hipfft_estimate_getsize_d.f03 | 158 ++++++ .../test/hipfft_estimate_getsize_d.f08 | 182 +++++++ .../fortran/test/hipfft_makeplanmany_z.f03 | 138 +++++ .../fortran/test/hipfft_makeplanmany_z.f08 | 145 ++++++ .../fortran/test/hipfft_planmany_2d_z2z.f03 | 119 +++++ .../fortran/test/hipfft_planmany_2d_z2z.f08 | 132 +++++ .../fortran/test/hipfft_r2c_c2r_1d_d.f03 | 91 ++++ .../fortran/test/hipfft_r2c_c2r_1d_d.f08 | 92 ++++ .../fortran/test/hipfft_r2c_c2r_1d_s.f03 | 91 ++++ .../fortran/test/hipfft_r2c_c2r_1d_s.f08 | 92 ++++ .../fortran/test/hipfft_setstream_z.f03 | 127 +++++ .../fortran/test/hipfft_setstream_z.f08 | 136 +++++ .../hipfft/fortran/test/hipfft_version.f03 | 84 ++++ .../hipfft/fortran/test/hipfft_version.f08 | 84 ++++ .../fortran/test/hipfft_xt_descriptor_z.f03 | 101 ++++ .../fortran/test/hipfft_xt_makeplanmany_c.f03 | 88 ++++ .../hipfft/fortran/test/hipfftw_alloc.f03 | 132 +++++ projects/hipfft/fortran/test/hipfftw_c2c.f03 | 88 ++++ .../hipfft/fortran/test/hipfftw_dft_2d.f03 | 95 ++++ .../hipfft/fortran/test/hipfftw_dft_3d.f03 | 101 ++++ projects/hipfft/fortran/test/hipfftw_guru.f03 | 137 +++++ .../hipfft/fortran/test/hipfftw_guru64.f03 | 96 ++++ projects/hipfft/fortran/test/hipfftw_many.f03 | 309 ++++++++++++ .../hipfft/fortran/test/hipfftw_r2c_c2r.f03 | 113 +++++ 50 files changed, 5219 insertions(+), 1 deletion(-) create mode 100644 projects/hipfft/fortran/CMakeLists.txt create mode 100644 projects/hipfft/fortran/cmake/toolchains/amdflang.cmake create mode 100644 projects/hipfft/fortran/cmake/toolchains/cray.cmake create mode 100644 projects/hipfft/fortran/cmake/toolchains/gnu.cmake create mode 100644 projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake create mode 100644 projects/hipfft/fortran/cmake/toolchains/intel.cmake create mode 100644 projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake create mode 100644 projects/hipfft/fortran/hipfft-fortran-config.cmake.in create mode 100644 projects/hipfft/fortran/hipfftw-fortran-config.cmake.in create mode 100644 projects/hipfft/fortran/test/CMakeLists.txt create mode 100644 projects/hipfft/fortran/test/hipfft.f03 create mode 100644 projects/hipfft/fortran/test/hipfft.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_1d_c.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_1d_c.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_1d_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_1d_z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_2d_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_2d_z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_3d_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_c2c_3d_z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_makeplanmany_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_makeplanmany_z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_setstream_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_setstream_z.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_version.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_version.f08 create mode 100644 projects/hipfft/fortran/test/hipfft_xt_descriptor_z.f03 create mode 100644 projects/hipfft/fortran/test/hipfft_xt_makeplanmany_c.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_alloc.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_c2c.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_dft_2d.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_dft_3d.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_guru.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_guru64.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_many.f03 create mode 100644 projects/hipfft/fortran/test/hipfftw_r2c_c2r.f03 diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 3df545d74867..5f9f96c50afa 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -199,6 +199,7 @@ /projects/hipfft/**/.readthedocs.yaml @ROCm/fft-reviewers @ROCm/fft-docs-reviewers /projects/hipfft/docs/ @ROCm/fft-reviewers @ROCm/fft-docs-reviewers /projects/hipfft/library/include/ @ROCm/fft-reviewers @ROCm/fft-docs-reviewers +/projects/hipfft/fortran/ @ROCm/rocm-fortran-maintainers @ROCm/fft-reviewers /projects/hiprand/**/*.md @ROCm/prims-rands-reviewers @ROCm/rands-docs-reviewers /projects/hiprand/**/*.rst @ROCm/prims-rands-reviewers @ROCm/rands-docs-reviewers diff --git a/projects/hipfft/CHANGELOG.md b/projects/hipfft/CHANGELOG.md index 9893362a248f..bba604b388fc 100644 --- a/projects/hipfft/CHANGELOG.md +++ b/projects/hipfft/CHANGELOG.md @@ -5,6 +5,20 @@ Documentation for hipFFT is available at ## (Unreleased) hipFFT 1.0.27 +### Added + +* Generated Fortran bindings, as two independent modules: `use hipfft` and link + `hip::hipfft_fortran` for the hipFFT API, or `use hipfftw` and link `hip::hipfftw_fortran` for the + FFTW compatibility API. + Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows and on the CUDA + backend), `BUILD_FORTRAN_CLIENTS` and `FORTRAN_ARRAY_INTERFACES` (`assumed-shape` by + default; `none` or `assumed-rank`); the `HIPFFT_*` and `HIPFFTW_*` spellings of the first two + switch either half on its own. Found with `find_package(hipfft-fortran)` and + `find_package(hipfftw-fortran)`; the archives and the `.mod` files install per compiler, + under `/fortran/` and `/fortran/`. + The archive has one section per procedure: link with `-Wl,--gc-sections` to keep only the wrappers + you call. + ### Changed * Minor internal changes. diff --git a/projects/hipfft/CMakeLists.txt b/projects/hipfft/CMakeLists.txt index 46dd44d2e4ae..ca0b7167b1e7 100644 --- a/projects/hipfft/CMakeLists.txt +++ b/projects/hipfft/CMakeLists.txt @@ -99,7 +99,8 @@ set(DEFAULT_GPUS ) if(BUILD_ADDRESS_SANITIZER) - add_compile_options(-fsanitize=address) + # Kept off Fortran; fortran/ skips its tests under ASan, so links no Fortran. + add_compile_options($<$:-fsanitize=address>) add_link_options(-fsanitize=address) add_link_options(-shared-libasan) SET(DEFAULT_GPUS @@ -209,6 +210,19 @@ endif() add_subdirectory( library ) +# fortran/ registers its tests under any client switch (BUILD_CLIENTS is +# expanded only below), but enable_testing() below needs BUILD_CLIENTS_TESTS. +if( BUILD_CLIENTS + OR BUILD_CLIENTS_SAMPLES + OR BUILD_CLIENTS_TESTS + OR BUILD_CLIENTS_BENCH ) + enable_testing() +endif() + +# Fortran bindings; self-guarding, reports HIP{FFT,FFTW}_HAVE_FORTRAN_BINDINGS. +# After library/, or its find_package( hipfft ) fallback finds an INSTALLED hipFFT. +add_subdirectory( fortran ) + # Build clients of the library if( BUILD_CLIENTS ) set( BUILD_CLIENTS_BENCH ON ) diff --git a/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst b/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst index 45c49e3d66d3..55f11d06d4a2 100644 --- a/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst +++ b/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst @@ -63,3 +63,9 @@ To build hipFFT and hipFFTW from source, follow these steps: .. note:: The ``-DBUILD_CLIENTS=ON`` option is only allowed with the amdclang++ or HIPCC compilers. + + The following CMake options control the Fortran bindings: + + * ``-DBUILD_FORTRAN_BINDINGS``: Builds the Fortran bindings. Defaults to ``ON`` on Linux, ``OFF`` on Windows and with the CUDA backend. + * ``-DBUILD_FORTRAN_CLIENTS``: Builds the Fortran binding tests when the clients are built. Defaults to ``ON``. + * ``-DFORTRAN_ARRAY_INTERFACES``: Selects the array interfaces. ``assumed-shape`` by default; ``none`` or ``assumed-rank``. diff --git a/projects/hipfft/fortran/CMakeLists.txt b/projects/hipfft/fortran/CMakeLists.txt new file mode 100644 index 000000000000..2c7dba608448 --- /dev/null +++ b/projects/hipfft/fortran/CMakeLists.txt @@ -0,0 +1,476 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# Fortran bindings for hipFFT and hipFFTW. hipfft.F90 and hipfftw.F90 are +# GENERATED by the rocm-fortran generator: regenerate them, do not edit them. +# The two modules are independent (hipfftw.F90 does not `use hipfft`). + +# Matches the hipFFT root, which adds this directory unconditionally. 3.17 +# ignores Fortran_PREPROCESS (3.18) but still preprocesses the .F90 extension. +cmake_minimum_required(VERSION 3.18) + +# LANGUAGES NONE: C is enabled only where a hip package lookup needs it. +if(CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) + project(hipfft-fortran LANGUAGES NONE) +endif() + +# ROCm ships no Fortran compiler on Windows, hence "${UNIX}". OFF on CUDA: the +# generated sources are untested against cuFFT. +if(BUILD_WITH_LIB STREQUAL "CUDA") + set(_hipfft_fortran_default OFF) +else() + set(_hipfft_fortran_default "${UNIX}") +endif() +# The only option(BUILD_FORTRAN_BINDINGS) in hipFFT: the first option() call +# fixes the cache entry, so a second default elsewhere would be ignored. +option(BUILD_FORTRAN_BINDINGS "Build the hipFFT and hipFFTW Fortran bindings" + "${_hipfft_fortran_default}") +unset(_hipfft_fortran_default) + +option(BUILD_FORTRAN_CLIENTS "Build the hipFFT and hipFFTW Fortran clients and binding tests" ON) + +# Both options are shared monorepo-wide; HIPFFT_* and HIPFFTW_* override them +# per binding. +set(_hipfft_bindings ${BUILD_FORTRAN_BINDINGS}) +set(_hipfftw_bindings ${BUILD_FORTRAN_BINDINGS}) +set(_hipfft_tests ${BUILD_FORTRAN_CLIENTS}) +set(_hipfftw_tests ${BUILD_FORTRAN_CLIENTS}) +if(DEFINED HIPFFT_BUILD_FORTRAN_BINDINGS) + set(_hipfft_bindings ${HIPFFT_BUILD_FORTRAN_BINDINGS}) +endif() +if(DEFINED HIPFFTW_BUILD_FORTRAN_BINDINGS) + set(_hipfftw_bindings ${HIPFFTW_BUILD_FORTRAN_BINDINGS}) +endif() +if(DEFINED HIPFFT_BUILD_FORTRAN_CLIENTS) + set(_hipfft_tests ${HIPFFT_BUILD_FORTRAN_CLIENTS}) +endif() +if(DEFINED HIPFFTW_BUILD_FORTRAN_CLIENTS) + set(_hipfftw_tests ${HIPFFTW_BUILD_FORTRAN_CLIENTS}) +endif() + +# Mutually exclusive tiers: assumed-rank REPLACES the per-rank overloads. +set(FORTRAN_ARRAY_INTERFACES "assumed-shape" CACHE STRING + "Array-argument overloads to expose: none, assumed-shape, or assumed-rank") +set_property(CACHE FORTRAN_ARRAY_INTERFACES PROPERTY STRINGS + none assumed-shape assumed-rank) + +if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) + set(HIPFFT_HAVE_FORTRAN_BINDINGS FALSE PARENT_SCOPE) + set(HIPFFTW_HAVE_FORTRAN_BINDINGS FALSE PARENT_SCOPE) +endif() + +if(NOT _hipfft_bindings AND NOT _hipfftw_bindings) + return() +endif() + +# Only reached when requested by hand. The symbols resolve against libhipfft +# (nvidia_detail) and cuFFTW (hip::hipfftw is its alias); only testing is missing. +if(BUILD_WITH_LIB STREQUAL "CUDA") + message(WARNING + "hipFFT: the Fortran bindings were requested on the CUDA backend. " + "hipfft.F90 and hipfftw.F90 are generated from the ROCm code path and are " + "not tested against a cuFFT-backed libhipfft, which is why they are off by " + "default there.") +endif() + +# ROCM_LIBS_HAVE_FORTRAN is the root's current name; drop it once the root +# publishes ROCM_HAVE_FORTRAN. +if(DEFINED ROCM_HAVE_FORTRAN) + set(_have_fortran ${ROCM_HAVE_FORTRAN}) +elseif(DEFINED ROCM_LIBS_HAVE_FORTRAN) + set(_have_fortran ${ROCM_LIBS_HAVE_FORTRAN}) +else() + include(CheckLanguage) + + # rocm-cmake's ROCMChecks watches CMAKE_Fortran_COMPILER and fails under + # ROCM_ERROR_TOOLCHAIN_VAR=ON; silence both flags across the probe. + set(_rocm_warn_toolchain_var "${ROCM_WARN_TOOLCHAIN_VAR}") + set(_rocm_error_toolchain_var "${ROCM_ERROR_TOOLCHAIN_VAR}") + set(ROCM_WARN_TOOLCHAIN_VAR OFF) + set(ROCM_ERROR_TOOLCHAIN_VAR OFF) + + # Prefer ROCm's amdflang over the first compiler on PATH (often gfortran); + # an explicit CMAKE_Fortran_COMPILER or FC still wins. + if(NOT CMAKE_Fortran_COMPILER AND NOT DEFINED ENV{FC}) + set(_rocm_fc_hints) + foreach(_rocm_fc_cc "${CMAKE_CXX_COMPILER}" "${CMAKE_C_COMPILER}" + "${CMAKE_HIP_COMPILER}") + if(_rocm_fc_cc) + get_filename_component(_rocm_fc_dir "${_rocm_fc_cc}" DIRECTORY) + list(APPEND _rocm_fc_hints "${_rocm_fc_dir}") + endif() + endforeach() + foreach(_rocm_fc_root "${ROCM_PATH}" "$ENV{ROCM_PATH}" "/opt/rocm") + if(_rocm_fc_root) + list(APPEND _rocm_fc_hints "${_rocm_fc_root}/bin" + "${_rocm_fc_root}/lib/llvm/bin") + endif() + endforeach() + if(_rocm_fc_hints) + # Uncached, so a changed ROCM_PATH is honoured on reconfigure. + unset(_rocm_amdflang CACHE) + find_program(_rocm_amdflang NAMES amdflang HINTS ${_rocm_fc_hints} + NO_DEFAULT_PATH) + # A ROCm tree can carry a dangling amdflang symlink. + if(_rocm_amdflang) + execute_process(COMMAND "${_rocm_amdflang}" --version + RESULT_VARIABLE _rocm_fc_rc + OUTPUT_QUIET ERROR_QUIET) + if(_rocm_fc_rc EQUAL 0) + set(CMAKE_Fortran_COMPILER "${_rocm_amdflang}" CACHE FILEPATH + "Fortran compiler used for the ROCm Fortran bindings" FORCE) + endif() + unset(_rocm_fc_rc) + endif() + unset(_rocm_amdflang CACHE) + endif() + unset(_rocm_fc_hints) + unset(_rocm_fc_cc) + unset(_rocm_fc_dir) + unset(_rocm_fc_root) + endif() + + check_language(Fortran) + set(ROCM_WARN_TOOLCHAIN_VAR "${_rocm_warn_toolchain_var}") + set(ROCM_ERROR_TOOLCHAIN_VAR "${_rocm_error_toolchain_var}") + unset(_rocm_warn_toolchain_var) + unset(_rocm_error_toolchain_var) + + if(CMAKE_Fortran_COMPILER) + set(_have_fortran TRUE) + else() + set(_have_fortran FALSE) + endif() +endif() + +if(NOT _have_fortran) + message(STATUS "hipFFT: no Fortran compiler found, skipping the Fortran bindings") + return() +endif() + +enable_language(Fortran) + +include(GNUInstallDirs) + +if(NOT FORTRAN_ARRAY_INTERFACES MATCHES "^(none|assumed-shape|assumed-rank)$") + message(FATAL_ERROR + "FORTRAN_ARRAY_INTERFACES must be none, assumed-shape or assumed-rank, " + "not '${FORTRAN_ARRAY_INTERFACES}'.") +endif() + +# A .mod is compiler-specific, so artifacts install per compiler. This mapping +# MUST match the one in both config templates. +if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(_fc_name "gfortran") +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Flang") # Flang, LLVMFlang + set(_fc_name "amdflang") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Cray") + set(_fc_name "ftn") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "IntelLLVM") + set(_fc_name "ifx") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set(_fc_name "ifort") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + set(_fc_name "nvfortran") +else() + get_filename_component(_fc_name "${CMAKE_Fortran_COMPILER}" NAME_WE) + string(TOLOWER "${_fc_name}" _fc_name) +endif() + +set(HIPFFT_FORTRAN_COMPILER_DIR "${_fc_name}" CACHE STRING + "Per-compiler subdirectory the .mod files and archives install under") + +# One layout for both bindings; the mirror only feeds hipfftw's config template. +set(HIPFFTW_FORTRAN_COMPILER_DIR "${HIPFFT_FORTRAN_COMPILER_DIR}") + +set(_moddir "${CMAKE_CURRENT_BINARY_DIR}/include") + +# Link interface only; one lookup defines hip::hipfft and hip::hipfftw. C is +# enabled because hip-config-amd.cmake reaches FindThreads. +if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) + if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) + enable_language(C) + endif() + find_package(hipfft QUIET) +endif() + +if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) + message(STATUS + "hipFFT: neither hip::hipfft nor hip::hipfftw was found, so the Fortran " + "bindings carry no link interface; a consumer will have to link the C " + "library (-lhipfft / -lhipfftw) itself. Point CMAKE_PREFIX_PATH at an " + "installed ROCm to have it recorded.") +endif() + +if(_hipfft_bindings) + add_library(hipfft_fortran STATIC hipfft.F90) + add_library(hip::hipfft_fortran ALIAS hipfft_fortran) + + # Each module compiles to one object, and a linker extracts whole objects from + # an archive, so a program that calls one wrapper links all of them. One section + # per procedure lets a program linked with -Wl,--gc-sections keep only the + # wrappers it calls, and still link when another wrapper names a C function the + # installed library does not export. Only these compilers split the sections + # (the Intel ones accept the flags but do not). + target_compile_options(hipfft_fortran PRIVATE + "$<$:-ffunction-sections;-fdata-sections>") + + set_target_properties(hipfft_fortran PROPERTIES + Fortran_MODULE_DIRECTORY "${_moddir}" + Fortran_PREPROCESS ON + Fortran_FORMAT FREE + POSITION_INDEPENDENT_CODE ON) + + if(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-shape") + target_compile_definitions(hipfft_fortran PRIVATE USE_ASSUMED_SHAPE=1) + elseif(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-rank") + target_compile_definitions(hipfft_fortran PRIVATE USE_ASSUMED_RANK=1) + endif() + + target_include_directories(hipfft_fortran PUBLIC + "$" + "$") + + # Always TRUE or FALSE: the config template substitutes it into an if(). + if(TARGET hip::hipfft) + target_link_libraries(hipfft_fortran INTERFACE hip::hipfft) + set(HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE TRUE) + else() + set(HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE FALSE) + endif() + + if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) + set(HIPFFT_HAVE_FORTRAN_BINDINGS TRUE PARENT_SCOPE) + endif() +endif() + +if(_hipfftw_bindings) + add_library(hipfftw_fortran STATIC hipfftw.F90) + add_library(hip::hipfftw_fortran ALIAS hipfftw_fortran) + + # Each module compiles to one object, and a linker extracts whole objects from + # an archive, so a program that calls one wrapper links all of them. One section + # per procedure lets a program linked with -Wl,--gc-sections keep only the + # wrappers it calls, and still link when another wrapper names a C function the + # installed library does not export. Only these compilers split the sections + # (the Intel ones accept the flags but do not). + target_compile_options(hipfftw_fortran PRIVATE + "$<$:-ffunction-sections;-fdata-sections>") + + # hipfftw.F90 has no guards today; kept so a regenerated one needs no change. + set_target_properties(hipfftw_fortran PROPERTIES + Fortran_MODULE_DIRECTORY "${_moddir}" + Fortran_PREPROCESS ON + Fortran_FORMAT FREE + POSITION_INDEPENDENT_CODE ON) + + if(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-shape") + target_compile_definitions(hipfftw_fortran PRIVATE USE_ASSUMED_SHAPE=1) + elseif(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-rank") + target_compile_definitions(hipfftw_fortran PRIVATE USE_ASSUMED_RANK=1) + endif() + + target_include_directories(hipfftw_fortran PUBLIC + "$" + "$") + + if(TARGET hip::hipfftw) + target_link_libraries(hipfftw_fortran INTERFACE hip::hipfftw) + set(HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE TRUE) + else() + set(HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE FALSE) + endif() + + if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) + set(HIPFFTW_HAVE_FORTRAN_BINDINGS TRUE PARENT_SCOPE) + endif() +endif() + +# In-tree the GPU tests follow hipFFT's client switches. BUILD_CLIENTS is read +# too: the root expands it into the other three only after this directory. +if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR + AND (_hipfft_tests OR _hipfftw_tests) + AND NOT (BUILD_CLIENTS OR BUILD_CLIENTS_BENCH OR BUILD_CLIENTS_SAMPLES + OR BUILD_CLIENTS_TESTS)) + message(STATUS + "hipFFT: clients are not being built, skipping the Fortran binding tests.") + set(_hipfft_tests OFF) + set(_hipfftw_tests OFF) +endif() + +# The uninstrumented Fortran executables cannot link an ASan libhipfft. +if((_hipfft_tests OR _hipfftw_tests) AND BUILD_ADDRESS_SANITIZER) + message(STATUS + "hipFFT: address sanitizer is enabled, skipping the Fortran binding tests.") + set(_hipfft_tests OFF) + set(_hipfftw_tests OFF) +endif() + +if(_hipfft_tests OR _hipfftw_tests) + # In-tree the root enables testing on the same condition. + enable_testing() + add_subdirectory(test) +endif() + +include(CMakePackageConfigHelpers) + +# From this tree's root, not hipfft_VERSION, which standalone is the INSTALLED +# hipFFT. One version for both packages. +set(_fortran_version "") +if(EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../CMakeLists.txt") + file(READ "${CMAKE_CURRENT_SOURCE_DIR}/../CMakeLists.txt" _hipfft_root) + set(_v_parts "") + foreach(_v_comp MAJOR MINOR PATCH) + # Judged on the whole match: a failed match leaves CMAKE_MATCH_1 stale. + string(REGEX MATCH "set[ \t]*\\([ \t]*HIPFFT_VERSION_${_v_comp}[ \t]+\"([0-9]+)\"" + _v_whole "${_hipfft_root}") + if(_v_whole) + list(APPEND _v_parts "${CMAKE_MATCH_1}") + endif() + endforeach() + list(LENGTH _v_parts _v_n) + if(_v_n EQUAL 3) + list(JOIN _v_parts "." _fortran_version) + endif() + unset(_hipfft_root) +endif() + +if(NOT _fortran_version) + message(STATUS + "hipFFT: could not determine the version for the Fortran packages, so no " + "hipfft-fortran-config-version.cmake or hipfftw-fortran-config-version.cmake " + "is installed; find_package(hipfft-fortran ) and " + "find_package(hipfftw-fortran ) will not match.") +endif() + +install(DIRECTORY "${_moddir}/" + DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}/fortran/${HIPFFT_FORTRAN_COMPILER_DIR}" + COMPONENT devel + FILES_MATCHING PATTERN "*.mod") + +set(HIPFFT_FORTRAN_LIBDIR "${CMAKE_INSTALL_LIBDIR}/fortran") +set(HIPFFT_FORTRAN_INCLUDEDIR "${CMAKE_INSTALL_INCLUDEDIR}/fortran") +set(HIPFFTW_FORTRAN_LIBDIR "${HIPFFT_FORTRAN_LIBDIR}") +set(HIPFFTW_FORTRAN_INCLUDEDIR "${HIPFFT_FORTRAN_INCLUDEDIR}") + +# Two independent packages, both in lib/cmake/hipfft beside hipfft-config.cmake. +if(_hipfft_bindings) + install(TARGETS hipfft_fortran + EXPORT hipfft-fortran-targets + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFT_FORTRAN_COMPILER_DIR}" + COMPONENT devel) + install(EXPORT hipfft-fortran-targets + FILE hipfft-fortran-targets.cmake + NAMESPACE hip:: + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + + # Under share/: the config reads every entry of include/fortran/ as a compiler. + install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfft.F90" + DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" + COMPONENT devel) + + configure_package_config_file( + "${CMAKE_CURRENT_SOURCE_DIR}/hipfft-fortran-config.cmake.in" + "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" + INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + PATH_VARS HIPFFT_FORTRAN_LIBDIR HIPFFT_FORTRAN_INCLUDEDIR) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + + # find_package(hipfft-fortran) searches lib/cmake/hipfft-fortran*. + file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" +"# Generated forwarder. The real config lives beside the hipFFT C package, in +# lib/cmake/hipfft, so that one CMAKE_PREFIX_PATH entry finds both. +# This file only exists so that find_package(hipfft-fortran) resolves to the +# same place. +include(\"\${CMAKE_CURRENT_LIST_DIR}/../hipfft/hipfft-fortran-config.cmake\") +") + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" + COMPONENT devel) + + if(_fortran_version) + write_basic_package_version_file( + "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" + VERSION "${_fortran_version}" + COMPATIBILITY SameMajorVersion) + # Beside both the config and the forwarder. + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" + COMPONENT devel) + endif() +endif() + +if(_hipfftw_bindings) + install(TARGETS hipfftw_fortran + EXPORT hipfftw-fortran-targets + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFTW_FORTRAN_COMPILER_DIR}" + COMPONENT devel) + install(EXPORT hipfftw-fortran-targets + FILE hipfftw-fortran-targets.cmake + NAMESPACE hip:: + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + + install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw.F90" + DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" + COMPONENT devel) + + configure_package_config_file( + "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw-fortran-config.cmake.in" + "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" + INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + PATH_VARS HIPFFTW_FORTRAN_LIBDIR HIPFFTW_FORTRAN_INCLUDEDIR) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + + file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" +"# Generated forwarder. hipFFTW ships inside the hipFFT package, so the real +# config lives in lib/cmake/hipfft beside hipfft-config.cmake. This file only +# exists so that find_package(hipfftw-fortran) resolves to the same place. +include(\"\${CMAKE_CURRENT_LIST_DIR}/../hipfft/hipfftw-fortran-config.cmake\") +") + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" + COMPONENT devel) + + if(_fortran_version) + write_basic_package_version_file( + "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" + VERSION "${_fortran_version}" + COMPATIBILITY SameMajorVersion) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" + COMPONENT devel) + endif() +endif() diff --git a/projects/hipfft/fortran/cmake/toolchains/amdflang.cmake b/projects/hipfft/fortran/cmake/toolchains/amdflang.cmake new file mode 100644 index 000000000000..8ebfda911904 --- /dev/null +++ b/projects/hipfft/fortran/cmake/toolchains/amdflang.cmake @@ -0,0 +1,30 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# AMD ROCm toolchain (amdflang). +# Usage, from projects/hipfft/fortran: +# cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/amdflang.cmake + +set(CMAKE_Fortran_COMPILER amdflang CACHE FILEPATH "Fortran compiler") +set(CMAKE_C_COMPILER amdclang CACHE FILEPATH "C compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/cray.cmake b/projects/hipfft/fortran/cmake/toolchains/cray.cmake new file mode 100644 index 000000000000..bcf5ed05a895 --- /dev/null +++ b/projects/hipfft/fortran/cmake/toolchains/cray.cmake @@ -0,0 +1,30 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# Cray toolchain (ftn and cc wrappers; the loaded PrgEnv module picks the compiler). +# Usage, from projects/hipfft/fortran: +# cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/cray.cmake + +set(CMAKE_Fortran_COMPILER ftn CACHE FILEPATH "Fortran compiler") +set(CMAKE_C_COMPILER cc CACHE FILEPATH "C compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/gnu.cmake b/projects/hipfft/fortran/cmake/toolchains/gnu.cmake new file mode 100644 index 000000000000..59295eae01f7 --- /dev/null +++ b/projects/hipfft/fortran/cmake/toolchains/gnu.cmake @@ -0,0 +1,30 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# GNU toolchain (gfortran). +# Usage, from projects/hipfft/fortran: +# cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/gnu.cmake + +set(CMAKE_Fortran_COMPILER gfortran CACHE FILEPATH "Fortran compiler") +set(CMAKE_C_COMPILER gcc CACHE FILEPATH "C compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake b/projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake new file mode 100644 index 000000000000..4382210ea4ba --- /dev/null +++ b/projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake @@ -0,0 +1,30 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# Classic Intel toolchain (ifort, deprecated by Intel in favour of ifx). +# Usage, from projects/hipfft/fortran: +# cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/intel-classic.cmake + +set(CMAKE_Fortran_COMPILER ifort CACHE FILEPATH "Fortran compiler") +set(CMAKE_C_COMPILER icx CACHE FILEPATH "C compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/intel.cmake b/projects/hipfft/fortran/cmake/toolchains/intel.cmake new file mode 100644 index 000000000000..d50ca3a65cee --- /dev/null +++ b/projects/hipfft/fortran/cmake/toolchains/intel.cmake @@ -0,0 +1,30 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# Intel oneAPI toolchain (ifx, the LLVM-based compiler). +# Usage, from projects/hipfft/fortran: +# cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/intel.cmake + +set(CMAKE_Fortran_COMPILER ifx CACHE FILEPATH "Fortran compiler") +set(CMAKE_C_COMPILER icx CACHE FILEPATH "C compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake b/projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake new file mode 100644 index 000000000000..36ca6638f8f8 --- /dev/null +++ b/projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake @@ -0,0 +1,30 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# NVIDIA HPC SDK toolchain (nvfortran). +# Usage, from projects/hipfft/fortran: +# cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/nvhpc.cmake + +set(CMAKE_Fortran_COMPILER nvfortran CACHE FILEPATH "Fortran compiler") +set(CMAKE_C_COMPILER nvc CACHE FILEPATH "C compiler") diff --git a/projects/hipfft/fortran/hipfft-fortran-config.cmake.in b/projects/hipfft/fortran/hipfft-fortran-config.cmake.in new file mode 100644 index 000000000000..50ffd829eb5d --- /dev/null +++ b/projects/hipfft/fortran/hipfft-fortran-config.cmake.in @@ -0,0 +1,156 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# Config package for the hipFFT Fortran bindings. +# +# find_package(hipfft-fortran REQUIRED) +# target_link_libraries(my_app PRIVATE hip::hipfft_fortran) +# +# One archive and .mod set is installed per Fortran compiler. Set +# HIPFFT_FORTRAN_COMPILER_DIR before find_package to pick one explicitly. + +@PACKAGE_INIT@ + +set(_hipfft_built_dir "@HIPFFT_FORTRAN_COMPILER_DIR@") + +# Absolute, relocatable paths written by PATH_VARS (see PACKAGE_INIT above). +set(_hipfft_libdir "@PACKAGE_HIPFFT_FORTRAN_LIBDIR@") +set(_hipfft_incdir "@PACKAGE_HIPFFT_FORTRAN_INCLUDEDIR@") + +set(hipfft_FORTRAN_FOUND FALSE) + +if(NOT CMAKE_Fortran_COMPILER_LOADED) + set(hipfft-fortran_FOUND FALSE) + string(CONCAT hipfft-fortran_NOT_FOUND_MESSAGE + "The hipFFT Fortran bindings need Fortran enabled before find_package: " + "add Fortran to your project() languages, or call enable_language(Fortran).") + return() +endif() + +# Accepts FC itself or FC plus a separator and suffix (gfortran-13). Not a regex: +# FC may be an arbitrary basename, and CMake has no regex-escape. Prefixed per +# package: hipfft- and hipfftw-fortran-config.cmake are often loaded together. +function(_hipfft_dir_matches DIR FC OUT) + set(${OUT} FALSE PARENT_SCOPE) + if(DIR STREQUAL FC) + set(${OUT} TRUE PARENT_SCOPE) + return() + endif() + string(LENGTH "${FC}" _n) + string(LENGTH "${DIR}" _dn) + if(_dn GREATER _n) + string(SUBSTRING "${DIR}" 0 ${_n} _head) + string(SUBSTRING "${DIR}" ${_n} 1 _sep) + if(_head STREQUAL FC AND _sep MATCHES "^[-._]$") + set(${OUT} TRUE PARENT_SCOPE) + endif() + endif() +endfunction() + +file(GLOB _hipfft_avail RELATIVE "${_hipfft_incdir}" "${_hipfft_incdir}/*") + +set(_hipfft_dir "") +if(DEFINED HIPFFT_FORTRAN_COMPILER_DIR) + if(NOT EXISTS "${_hipfft_incdir}/${HIPFFT_FORTRAN_COMPILER_DIR}/hipfft.mod" OR + NOT EXISTS "${_hipfft_libdir}/${HIPFFT_FORTRAN_COMPILER_DIR}/libhipfft_fortran.a") + set(hipfft-fortran_FOUND FALSE) + string(CONCAT hipfft-fortran_NOT_FOUND_MESSAGE + "HIPFFT_FORTRAN_COMPILER_DIR is '${HIPFFT_FORTRAN_COMPILER_DIR}', but " + "no hipfft.mod and libhipfft_fortran.a are installed under " + "${_hipfft_incdir}/${HIPFFT_FORTRAN_COMPILER_DIR} and " + "${_hipfft_libdir}/${HIPFFT_FORTRAN_COMPILER_DIR}. Available: " + "${_hipfft_avail}.") + return() + endif() + set(_hipfft_dir "${HIPFFT_FORTRAN_COMPILER_DIR}") +else() + # Must mirror the mapping in projects/hipfft/fortran/CMakeLists.txt. + if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(_hipfft_fc "gfortran") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Flang") + set(_hipfft_fc "amdflang") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Cray") + set(_hipfft_fc "ftn") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "IntelLLVM") + set(_hipfft_fc "ifx") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set(_hipfft_fc "ifort") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + set(_hipfft_fc "nvfortran") + else() + get_filename_component(_hipfft_fc "${CMAKE_Fortran_COMPILER}" NAME_WE) + string(TOLOWER "${_hipfft_fc}" _hipfft_fc) + endif() + + # A prefix can hold several compilers' artifacts; the recorded one is a fallback. + if(EXISTS "${_hipfft_incdir}/${_hipfft_fc}/hipfft.mod") + set(_hipfft_dir "${_hipfft_fc}") + else() + _hipfft_dir_matches("${_hipfft_built_dir}" "${_hipfft_fc}" _hipfft_ok) + if(_hipfft_ok) + set(_hipfft_dir "${_hipfft_built_dir}") + endif() + endif() + + if(NOT _hipfft_dir) + set(hipfft-fortran_FOUND FALSE) + string(CONCAT hipfft-fortran_NOT_FOUND_MESSAGE + "This project builds with ${_hipfft_fc}, but no hipfft.mod for it is " + "installed under ${_hipfft_incdir}. Available: " + "${_hipfft_avail}. A Fortran .mod cannot be shared across compilers; " + "rebuild the bindings with ${_hipfft_fc}, or set " + "HIPFFT_FORTRAN_COMPILER_DIR to the directory to use.") + return() + endif() +endif() + +# Written TRUE only when the archive links hip::hipfft, which must be imported +# before the targets file. hip's config needs C or CXX enabled (FindThreads). +if(@HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE@) + if(NOT TARGET hip::hipfft) + if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) + enable_language(C) + endif() + include(CMakeFindDependencyMacro) + find_dependency(hipfft) + endif() +endif() + +include("${CMAKE_CURRENT_LIST_DIR}/hipfft-fortran-targets.cmake") + +# The targets file hardcodes the directory the package was built with. +if(NOT _hipfft_dir STREQUAL "${_hipfft_built_dir}") + set_target_properties(hip::hipfft_fortran PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES "${_hipfft_incdir}/${_hipfft_dir}") + get_target_property(_hipfft_cfgs hip::hipfft_fortran IMPORTED_CONFIGURATIONS) + foreach(_hipfft_c IN LISTS _hipfft_cfgs) + set_target_properties(hip::hipfft_fortran PROPERTIES + IMPORTED_LOCATION_${_hipfft_c} + "${_hipfft_libdir}/${_hipfft_dir}/libhipfft_fortran.a") + endforeach() +endif() + +set(hipfft_FORTRAN_FOUND TRUE) + +check_required_components(hipfft-fortran) diff --git a/projects/hipfft/fortran/hipfftw-fortran-config.cmake.in b/projects/hipfft/fortran/hipfftw-fortran-config.cmake.in new file mode 100644 index 000000000000..3974128bf4ef --- /dev/null +++ b/projects/hipfft/fortran/hipfftw-fortran-config.cmake.in @@ -0,0 +1,156 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# Config package for the hipFFTW Fortran bindings. +# +# find_package(hipfftw-fortran REQUIRED) +# target_link_libraries(my_app PRIVATE hip::hipfftw_fortran) +# +# One archive and .mod set is installed per Fortran compiler. Set +# HIPFFTW_FORTRAN_COMPILER_DIR before find_package to pick one explicitly. + +@PACKAGE_INIT@ + +set(_hipfftw_built_dir "@HIPFFTW_FORTRAN_COMPILER_DIR@") + +# Absolute, relocatable paths written by PATH_VARS (see PACKAGE_INIT above). +set(_hipfftw_libdir "@PACKAGE_HIPFFTW_FORTRAN_LIBDIR@") +set(_hipfftw_incdir "@PACKAGE_HIPFFTW_FORTRAN_INCLUDEDIR@") + +set(hipfftw_FORTRAN_FOUND FALSE) + +if(NOT CMAKE_Fortran_COMPILER_LOADED) + set(hipfftw-fortran_FOUND FALSE) + string(CONCAT hipfftw-fortran_NOT_FOUND_MESSAGE + "The hipFFTW Fortran bindings need Fortran enabled before find_package: " + "add Fortran to your project() languages, or call enable_language(Fortran).") + return() +endif() + +# Accepts FC itself or FC plus a separator and suffix (gfortran-13). Not a regex: +# FC may be an arbitrary basename, and CMake has no regex-escape. Prefixed per +# package: hipfft- and hipfftw-fortran-config.cmake are often loaded together. +function(_hipfftw_dir_matches DIR FC OUT) + set(${OUT} FALSE PARENT_SCOPE) + if(DIR STREQUAL FC) + set(${OUT} TRUE PARENT_SCOPE) + return() + endif() + string(LENGTH "${FC}" _n) + string(LENGTH "${DIR}" _dn) + if(_dn GREATER _n) + string(SUBSTRING "${DIR}" 0 ${_n} _head) + string(SUBSTRING "${DIR}" ${_n} 1 _sep) + if(_head STREQUAL FC AND _sep MATCHES "^[-._]$") + set(${OUT} TRUE PARENT_SCOPE) + endif() + endif() +endfunction() + +file(GLOB _hipfftw_avail RELATIVE "${_hipfftw_incdir}" "${_hipfftw_incdir}/*") + +set(_hipfftw_dir "") +if(DEFINED HIPFFTW_FORTRAN_COMPILER_DIR) + if(NOT EXISTS "${_hipfftw_incdir}/${HIPFFTW_FORTRAN_COMPILER_DIR}/hipfftw.mod" OR + NOT EXISTS "${_hipfftw_libdir}/${HIPFFTW_FORTRAN_COMPILER_DIR}/libhipfftw_fortran.a") + set(hipfftw-fortran_FOUND FALSE) + string(CONCAT hipfftw-fortran_NOT_FOUND_MESSAGE + "HIPFFTW_FORTRAN_COMPILER_DIR is '${HIPFFTW_FORTRAN_COMPILER_DIR}', but " + "no hipfftw.mod and libhipfftw_fortran.a are installed under " + "${_hipfftw_incdir}/${HIPFFTW_FORTRAN_COMPILER_DIR} and " + "${_hipfftw_libdir}/${HIPFFTW_FORTRAN_COMPILER_DIR}. Available: " + "${_hipfftw_avail}.") + return() + endif() + set(_hipfftw_dir "${HIPFFTW_FORTRAN_COMPILER_DIR}") +else() + # Must mirror the mapping in projects/hipfft/fortran/CMakeLists.txt. + if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(_hipfftw_fc "gfortran") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Flang") + set(_hipfftw_fc "amdflang") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Cray") + set(_hipfftw_fc "ftn") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "IntelLLVM") + set(_hipfftw_fc "ifx") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set(_hipfftw_fc "ifort") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + set(_hipfftw_fc "nvfortran") + else() + get_filename_component(_hipfftw_fc "${CMAKE_Fortran_COMPILER}" NAME_WE) + string(TOLOWER "${_hipfftw_fc}" _hipfftw_fc) + endif() + + # A prefix can hold several compilers' artifacts; the recorded one is a fallback. + if(EXISTS "${_hipfftw_incdir}/${_hipfftw_fc}/hipfftw.mod") + set(_hipfftw_dir "${_hipfftw_fc}") + else() + _hipfftw_dir_matches("${_hipfftw_built_dir}" "${_hipfftw_fc}" _hipfftw_ok) + if(_hipfftw_ok) + set(_hipfftw_dir "${_hipfftw_built_dir}") + endif() + endif() + + if(NOT _hipfftw_dir) + set(hipfftw-fortran_FOUND FALSE) + string(CONCAT hipfftw-fortran_NOT_FOUND_MESSAGE + "This project builds with ${_hipfftw_fc}, but no hipfftw.mod for it is " + "installed under ${_hipfftw_incdir}. Available: " + "${_hipfftw_avail}. A Fortran .mod cannot be shared across compilers; " + "rebuild the bindings with ${_hipfftw_fc}, or set " + "HIPFFTW_FORTRAN_COMPILER_DIR to the directory to use.") + return() + endif() +endif() + +# Written TRUE only when the archive links hip::hipfftw, which must be imported +# before the targets file. hip's config needs C or CXX enabled (FindThreads). +if(@HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE@) + if(NOT TARGET hip::hipfftw) + if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) + enable_language(C) + endif() + include(CMakeFindDependencyMacro) + find_dependency(hipfft) + endif() +endif() + +include("${CMAKE_CURRENT_LIST_DIR}/hipfftw-fortran-targets.cmake") + +# The targets file hardcodes the directory the package was built with. +if(NOT _hipfftw_dir STREQUAL "${_hipfftw_built_dir}") + set_target_properties(hip::hipfftw_fortran PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES "${_hipfftw_incdir}/${_hipfftw_dir}") + get_target_property(_hipfftw_cfgs hip::hipfftw_fortran IMPORTED_CONFIGURATIONS) + foreach(_hipfftw_c IN LISTS _hipfftw_cfgs) + set_target_properties(hip::hipfftw_fortran PROPERTIES + IMPORTED_LOCATION_${_hipfftw_c} + "${_hipfftw_libdir}/${_hipfftw_dir}/libhipfftw_fortran.a") + endforeach() +endif() + +set(hipfftw_FORTRAN_FOUND TRUE) + +check_required_components(hipfftw-fortran) diff --git a/projects/hipfft/fortran/test/CMakeLists.txt b/projects/hipfft/fortran/test/CMakeLists.txt new file mode 100644 index 000000000000..430667c2a500 --- /dev/null +++ b/projects/hipfft/fortran/test/CMakeLists.txt @@ -0,0 +1,180 @@ +# ############################################################################# +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# +# SPDX-License-Identifier: MIT +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +# ############################################################################ + +# hipFFT and hipFFTW Fortran binding tests: one GPU executable per test. Each +# half guards itself on its own binding target and C library. + +# ifx/ifort skip .f03/.f08 files unless -Tf precedes the source. +if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + string(REPLACE "" "-Tf " + CMAKE_Fortran_COMPILE_OBJECT "${CMAKE_Fortran_COMPILE_OBJECT}") +endif() + +# Keep only the binding wrappers a test calls (the archive has one section per +# procedure), so a test links even when another wrapper names a C symbol the +# installed library does not export. Spelled -Wl, rather than LINKER:, which +# CMake 3.27 passes to LLVMFlang as a bare --gc-sections. +if(NOT APPLE AND NOT WIN32) + add_link_options(-Wl,--gc-sections) +endif() + +# hip-config-amd.cmake reaches FindThreads, which needs C or CXX enabled. +if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) + if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) + enable_language(C) + endif() + find_package(hipfft QUIET) +endif() + +# The tests `use hip`, so hip.mod (rocm-systems, same compiler) is required. +if(NOT TARGET hip::hip_fortran) + find_package(hip-fortran QUIET) +endif() +if(NOT TARGET hip::hip_fortran) + message(STATUS + "hipFFT: no hip::hip_fortran target, skipping the Fortran runtime tests " + "of both bindings (they `use hip`). Install the HIP Fortran bindings for " + "this compiler to build them.") +endif() + +if(NOT _hipfft_tests) + # Deliberately silent: the parent was told not to build this half. +elseif(NOT TARGET hipfft_fortran) + message(STATUS + "hipFFT: the Fortran binding target was not built, skipping its tests.") +elseif(NOT TARGET hip::hipfft) + message(STATUS + "hipFFT: no hip::hipfft target, skipping the hipFFT Fortran binding tests " + "(they link libhipfft). Point CMAKE_PREFIX_PATH at an installed ROCm to " + "build them standalone.") +else() + # hipfft_fortran_add_test( [F2008]): F2008 builds .f08, which + # exercises the array overloads, as test hipfft_fortran__f2008. + function(hipfft_fortran_add_test name) + if("F2008" IN_LIST ARGN) + set(src "${CMAKE_CURRENT_SOURCE_DIR}/${name}.f08") + set(test_name "${name}_f2008") + else() + set(src "${CMAKE_CURRENT_SOURCE_DIR}/${name}.f03") + set(test_name "${name}") + endif() + if(NOT EXISTS "${src}") + message(FATAL_ERROR "Missing test source: ${src}") + endif() + set_source_files_properties("${src}" PROPERTIES LANGUAGE Fortran) + add_executable(hipfft_fortran_test_${test_name} "${src}") + set_target_properties(hipfft_fortran_test_${test_name} PROPERTIES LINKER_LANGUAGE Fortran) + target_link_libraries(hipfft_fortran_test_${test_name} + PRIVATE hipfft_fortran hip::hip_fortran hip::hipfft) + # EXIT is a GNU extension. + target_compile_options(hipfft_fortran_test_${test_name} PRIVATE + $<$:-std=gnu>) + add_test(NAME hipfft_fortran_${test_name} COMMAND hipfft_fortran_test_${test_name}) + # ctest -LE gpu skips them on a GPU-less machine. + set_tests_properties(hipfft_fortran_${test_name} PROPERTIES LABELS "gpu") + endfunction() + + if(TARGET hip::hip_fortran) + set(HIPFFT_FORTRAN_TESTS + hipfft + hipfft_c2c_1d_batched_z + hipfft_c2c_1d_c + hipfft_c2c_1d_z + hipfft_c2c_2d_z + hipfft_c2c_3d_z + hipfft_estimate_getsize_d + hipfft_makeplanmany_z + hipfft_planmany_2d_z2z + hipfft_r2c_c2r_1d_d + hipfft_r2c_c2r_1d_s + hipfft_setstream_z + hipfft_version + hipfft_xt_descriptor_z + hipfft_xt_makeplanmany_c) + + foreach(_t IN LISTS HIPFFT_FORTRAN_TESTS) + hipfft_fortran_add_test(${_t}) + endforeach() + # Exits 77 when fewer than two GPUs are present. + set_tests_properties(hipfft_fortran_hipfft_xt_descriptor_z PROPERTIES + SKIP_RETURN_CODE 77) + + # The .f08 variants use the array overloads, present in both the + # assumed-shape and the assumed-rank tier. + # The Xt tests have none: the Xt API passes descriptors, not arrays. + if(NOT FORTRAN_ARRAY_INTERFACES STREQUAL "none") + set(HIPFFT_FORTRAN_F2008_TESTS ${HIPFFT_FORTRAN_TESTS}) + list(FILTER HIPFFT_FORTRAN_F2008_TESTS EXCLUDE REGEX "^hipfft_xt_") + foreach(_t IN LISTS HIPFFT_FORTRAN_F2008_TESTS) + hipfft_fortran_add_test(${_t} F2008) + endforeach() + endif() + endif() +endif() + +if(NOT _hipfftw_tests) + # Deliberately silent: the parent was told not to build this half. +elseif(NOT TARGET hipfftw_fortran) + message(STATUS + "hipFFTW: the Fortran binding target was not built, skipping its tests.") +elseif(NOT TARGET hip::hipfftw) + message(STATUS + "hipFFTW: no hip::hipfftw target, skipping the hipFFTW Fortran binding " + "tests (they link libhipfftw). Point CMAKE_PREFIX_PATH at an installed " + "ROCm to build them standalone.") +else() + function(hipfftw_fortran_add_test name) + set(src "${CMAKE_CURRENT_SOURCE_DIR}/${name}.f03") + if(NOT EXISTS "${src}") + message(FATAL_ERROR "Missing test source: ${src}") + endif() + set_source_files_properties("${src}" PROPERTIES LANGUAGE Fortran) + add_executable(hipfftw_fortran_test_${name} "${src}") + set_target_properties(hipfftw_fortran_test_${name} PROPERTIES + LINKER_LANGUAGE Fortran) + target_link_libraries(hipfftw_fortran_test_${name} PRIVATE + hipfftw_fortran hip::hipfftw hip::hip_fortran) + # EXIT is a GNU extension. + target_compile_options(hipfftw_fortran_test_${name} PRIVATE + $<$:-std=gnu>) + add_test(NAME hipfftw_fortran_${name} COMMAND hipfftw_fortran_test_${name}) + set_tests_properties(hipfftw_fortran_${name} PROPERTIES LABELS "gpu") + endfunction() + + if(TARGET hip::hip_fortran) + set(HIPFFTW_FORTRAN_TESTS + hipfftw_alloc + hipfftw_c2c + hipfftw_dft_2d + hipfftw_dft_3d + hipfftw_guru + hipfftw_guru64 + hipfftw_many + hipfftw_r2c_c2r) + + foreach(_t IN LISTS HIPFFTW_FORTRAN_TESTS) + hipfftw_fortran_add_test(${_t}) + endforeach() + endif() +endif() diff --git a/projects/hipfft/fortran/test/hipfft.f03 b/projects/hipfft/fortran/test/hipfft.f03 new file mode 100644 index 000000000000..aba6b8b9b027 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft.f03 @@ -0,0 +1,104 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2021 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_example + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_size_t), parameter :: N = 16 + integer(c_size_t), parameter :: Nbytes = N * 8 * 2 + + type double2 + double precision :: x + double precision :: y + end type double2 + + type(double2), allocatable, target, dimension(:) :: hx + complex(8), allocatable, dimension(:) :: x_in, x_ref + integer(c_int) :: direction = HIPFFT_FORWARD + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer(c_size_t), allocatable, target, dimension(:) :: lengths + integer(c_size_t), parameter :: one = 1 + integer :: i, j + double precision :: error + double precision, parameter :: error_max = 100*epsilon(error) + double precision, parameter :: two_pi = 2*acos(-1.0d0) + + write(*,"(a)",advance="no") "-- Running test 'hipFFT' (Fortran 2003 interfaces) - " + + allocate(lengths(3)) + lengths(1) = N + + ! A non-constant input, so that a transform that leaves the data untouched + ! cannot pass. The reference is a direct O(N^2) DFT on the host; the + ! twiddle exponent is reduced modulo N so the angle stays in [0, 2*pi). + allocate(hx(N), x_in(N), x_ref(N)) + do i = 1, int(N) + x_in(i) = cmplx(i, mod(3*i, 5) - 2, kind=8) + hx(i)%x = real(x_in(i), 8) + hx(i)%y = aimag(x_in(i)) + end do + do i = 1, int(N) + x_ref(i) = (0.d0, 0.d0) + do j = 1, int(N) + x_ref(i) = x_ref(i) + x_in(j) * exp(cmplx(0.d0, -two_pi*mod((i-1)*(j-1), int(N))/N, kind=8)) + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + call hipfftCheck(hipfftPlan1d(plan, int(N, 4), HIPFFT_Z2Z, 1)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + + + call hipCheck(hipDeviceSynchronize()) + + + call hipCheck(hipMemcpy(c_loc(hx(1)),dx,Nbytes,hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + do i = 1, int(N) + error = abs(cmplx(hx(i)%x, hx(i)%y, kind=8) - x_ref(i)) + if (.not. (error <= error_max * sum(abs(x_in)))) then + write(*,*) "FAILED! i = ", i, " error = ", error, " hx(i) = ", hx(i)%x, hx(i)%y + call exit(1) + end if + end do + + deallocate(hx, x_in, x_ref) + deallocate(lengths) + + + call hipfftcheck( hipfftDestroy(plan)) + + write(*,*) "PASSED!" + +end program hipfft_example \ No newline at end of file diff --git a/projects/hipfft/fortran/test/hipfft.f08 b/projects/hipfft/fortran/test/hipfft.f08 new file mode 100644 index 000000000000..eb641ad574f1 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft.f08 @@ -0,0 +1,88 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_example + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + + complex(8), allocatable, dimension(:) :: hx, x_ref + integer(c_int) :: direction = HIPFFT_FORWARD + complex(8), pointer, dimension(:) :: dx + type(c_ptr) :: plan = c_null_ptr + integer(c_size_t) :: lengths(3) + integer(c_size_t), parameter :: one = 1 + integer :: i, j + double precision :: error, x_scale + double precision, parameter :: error_max = 100*epsilon(error) + double precision, parameter :: two_pi = 2*acos(-1.0d0) + + write(*,"(a)",advance="no") "-- Running test 'hipFFT' (Fortran 2008 interfaces) - " + + lengths(1) = N + + ! A non-constant input, so that a transform that leaves the data untouched + ! cannot pass. The reference is a direct O(N^2) DFT on the host. + allocate(hx(N), x_ref(N)) + do i = 1, N + hx(i) = cmplx(i, mod(3*i, 5) - 2, kind=8) + end do + do i = 1, N + x_ref(i) = (0.d0, 0.d0) + do j = 1, N + x_ref(i) = x_ref(i) + hx(j) * exp(cmplx(0.d0, -two_pi*mod((i-1)*(j-1), N)/N, kind=8)) + end do + end do + x_scale = sum(abs(hx)) + + call hipCheck(hipMalloc(dx, source=hx)) + + call hipfftCheck(hipfftPlan1d(plan, N, HIPFFT_Z2Z, 1)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + + call hipCheck(hipDeviceSynchronize()) + + call hipCheck(hipMemcpy(hx,dx,hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + do i = 1, N + error = abs(hx(i) - x_ref(i)) + if (.not. (error <= error_max * x_scale)) then + write(*,*) "FAILED! i = ", i, " error = ", error, " hx(i) = ", hx(i) + call exit(1) + end if + end do + + deallocate(hx, x_ref) + + call hipfftcheck( hipfftDestroy(plan)) + + write(*,*) "PASSED!" +end program hipfft_example diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f03 b/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f03 new file mode 100644 index 000000000000..7c96f53c0be0 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f03 @@ -0,0 +1,102 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_1d_batched_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Nbatch = 4 + integer(c_int), parameter :: Ntot = N * Nbatch + integer(c_size_t), parameter :: Nbytes = int(Ntot,c_size_t)*8*2 + + ! The raw hipfftPlanMany_ interface takes integer(c_int) by value. + integer(c_int), parameter :: one_i = 1 + + type double2 + double precision :: x + double precision :: y + end type double2 + + type(double2), allocatable, target, dimension(:) :: hx, hx_input + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer(c_int), target :: nlen(1) + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 1D batched double (z)' (Fortran 2003 interfaces) - " + + nlen(1) = N + + allocate(hx(Ntot)) + allocate(hx_input(Ntot)) + do i = 1, Ntot + hx(i)%x = dble(i) + hx(i)%y = dble(Ntot - i) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! c_loc/c_null_ptr select the raw hipfftPlanMany_ interface; NULL + ! inembed/onembed means contiguous batches (idist = odist = N). + call hipfftCheck(hipfftPlanMany(plan, one_i, c_loc(nlen), & + c_null_ptr, one_i, N, & + c_null_ptr, one_i, N, & + HIPFFT_Z2Z, Nbatch)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_BACKWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized: forward+inverse yields N (per-transform length, + ! not Ntot) times the original input for each element. + do i = 1, Ntot + error = abs(hx(i)%x - N * hx_input(i)%x) + abs(hx(i)%y - N * hx_input(i)%y) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_1d_batched_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f08 b/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f08 new file mode 100644 index 000000000000..1691dbf69c61 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f08 @@ -0,0 +1,106 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_1d_batched_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Nbatch = 4 + integer(c_int), parameter :: Ntot = N * Nbatch + + ! one_i avoids ambiguity: the raw hipfftPlanMany_ interface requires integer(c_int) + ! VALUE arguments, and a bare literal '1' would have the default integer kind. + integer(c_int), parameter :: one_i = 1 + + complex(8), allocatable, target, dimension(:) :: hx, hx_input + complex(8), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + integer(c_int) :: direction + ! nlen is the per-dimension transform length array passed by address to + ! hipfftPlanMany (it cannot be called "n": Fortran is case-insensitive and N + ! is already the transform length parameter). + integer(c_int), target :: nlen(1) + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 1D batched double (z)' (Fortran 2008 interfaces) - " + + nlen(1) = N + + allocate(hx(Ntot)) + allocate(hx_input(Ntot)) + do i = 1, Ntot + hx(i) = cmplx(dble(i), dble(Ntot - i), kind=8) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, source=hx)) + + ! NULL inembed/onembed selects the simple contiguous batched layout: each + ! transform spans N consecutive complex doubles (istride=1, idist=N, + ! ostride=1, odist=N). Passing c_loc(nlen) and c_null_ptr routes to the raw + ! hipfftPlanMany_ C interface rather than the array + ! overloads (which expect integer(c_int) arrays for n, inembed, onembed). + ! Unlike rocFFT, a single plan handle serves both directions; the direction + ! is supplied at exec time via hipfftExecZ2Z. + call hipfftCheck(hipfftPlanMany(plan, one_i, c_loc(nlen), & + c_null_ptr, one_i, N, & + c_null_ptr, one_i, N, & + HIPFFT_Z2Z, Nbatch)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + direction = HIPFFT_BACKWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized: forward+inverse yields N (per-transform length, + ! not Ntot) times the original input for each element. + do i = 1, Ntot + error = abs(hx(i) - N * hx_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hx(i), " expected=", N * hx_input(i) + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_1d_batched_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f03 b/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f03 new file mode 100644 index 000000000000..d46a8aedf6e8 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f03 @@ -0,0 +1,90 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_1d_c + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_size_t), parameter :: Nbytes = int(N,c_size_t)*4*2 + + type float2 + real :: x + real :: y + end type float2 + + type(float2), allocatable, target, dimension(:) :: hx, hx_input + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: i + real :: error + real, parameter :: error_max = 1.0e-4 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 1D single (c)' (Fortran 2003 interfaces) - " + + allocate(hx(N)) + allocate(hx_input(N)) + do i = 1, N + hx(i)%x = real(i) + hx(i)%y = real(N - i) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! A single hipFFT plan covers both directions: the transform direction is + ! passed to hipfftExecC2C rather than baked into the plan. + call hipfftCheck(hipfftPlan1d(plan, N, HIPFFT_C2C, 1)) + + call hipfftCheck(hipfftExecC2C(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftExecC2C(plan, dx, dx, HIPFFT_BACKWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields N times the original input. + do i = 1, N + error = abs(hx(i)%x - N * hx_input(i)%x) + abs(hx(i)%y - N * hx_input(i)%y) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_1d_c diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f08 b/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f08 new file mode 100644 index 000000000000..b0c461a1aa77 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f08 @@ -0,0 +1,85 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_1d_c + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + + complex(4), allocatable, target, dimension(:) :: hx, hx_input + complex(4), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + integer(c_int) :: direction + integer :: i + real :: error + real, parameter :: error_max = 1.0e-4 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 1D single (c)' (Fortran 2008 interfaces) - " + + allocate(hx(N)) + allocate(hx_input(N)) + do i = 1, N + hx(i) = cmplx(real(i), real(N - i), kind=4) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, source=hx)) + + ! A single hipFFT plan covers both directions: the transform direction is + ! passed to hipfftExecC2C rather than baked into the plan. + call hipfftCheck(hipfftPlan1d(plan, N, HIPFFT_C2C, 1)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecC2C(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + direction = HIPFFT_BACKWARD + call hipfftCheck(hipfftExecC2C(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields N times the original input. + do i = 1, N + error = abs(hx(i) - N * hx_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hx(i), " expected=", N * hx_input(i) + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_1d_c diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f03 b/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f03 new file mode 100644 index 000000000000..cafdaeb07884 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f03 @@ -0,0 +1,90 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_1d_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_size_t), parameter :: Nbytes = int(N,c_size_t)*8*2 + + type double2 + double precision :: x + double precision :: y + end type double2 + + type(double2), allocatable, target, dimension(:) :: hx, hx_input + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 1D double (z)' (Fortran 2003 interfaces) - " + + allocate(hx(N)) + allocate(hx_input(N)) + do i = 1, N + hx(i)%x = dble(i) + hx(i)%y = dble(N - i) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! A single hipFFT plan serves both directions: unlike rocFFT, the direction is + ! an argument of hipfftExecZ2Z rather than a property of the plan. + call hipfftCheck(hipfftPlan1d(plan, N, HIPFFT_Z2Z, 1)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_BACKWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields N times the original input. + do i = 1, N + error = abs(hx(i)%x - N * hx_input(i)%x) + abs(hx(i)%y - N * hx_input(i)%y) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_1d_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f08 b/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f08 new file mode 100644 index 000000000000..afa48d29fedf --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f08 @@ -0,0 +1,85 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_1d_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + + complex(8), allocatable, target, dimension(:) :: hx, hx_input + complex(8), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + integer(c_int) :: direction + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 1D double (z)' (Fortran 2008 interfaces) - " + + allocate(hx(N)) + allocate(hx_input(N)) + do i = 1, N + hx(i) = cmplx(dble(i), dble(N - i), kind=8) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, source=hx)) + + ! A single hipFFT plan serves both directions: unlike rocFFT, the direction is + ! an argument of hipfftExecZ2Z rather than a property of the plan. + call hipfftCheck(hipfftPlan1d(plan, N, HIPFFT_Z2Z, 1)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + direction = HIPFFT_BACKWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields N times the original input. + do i = 1, N + error = abs(hx(i) - N * hx_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hx(i), " expected=", N * hx_input(i) + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_1d_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f03 b/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f03 new file mode 100644 index 000000000000..e9ff89a8a459 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f03 @@ -0,0 +1,91 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_2d_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: Nx = 4, Ny = 8 + integer(c_int), parameter :: Ntot = Nx * Ny + integer(c_size_t), parameter :: Nbytes = int(Ntot,c_size_t)*8*2 + + type double2 + double precision :: x + double precision :: y + end type double2 + + type(double2), allocatable, target, dimension(:) :: hx, hx_input + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 2D double (z)' (Fortran 2003 interfaces) - " + + allocate(hx(Ntot)) + allocate(hx_input(Ntot)) + do i = 1, Ntot + hx(i)%x = dble(i) + hx(i)%y = dble(Ntot - i) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! In-place 2D C2C plan over an Nx*Ny complex double grid; the direction is + ! supplied at exec time rather than at plan creation. + call hipfftCheck(hipfftPlan2d(plan, Nx, Ny, HIPFFT_Z2Z)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_BACKWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields Ntot times the original input. + do i = 1, Ntot + error = abs(hx(i)%x - Ntot * hx_input(i)%x) + abs(hx(i)%y - Ntot * hx_input(i)%y) + if (.not. (error <= error_max * Ntot)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_2d_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f08 b/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f08 new file mode 100644 index 000000000000..1d38de822d4d --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f08 @@ -0,0 +1,86 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_2d_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: Nx = 4, Ny = 8 + integer(c_int), parameter :: Ntot = Nx * Ny + + complex(8), allocatable, target, dimension(:) :: hx, hx_input + complex(8), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + integer(c_int) :: direction + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 2D double (z)' (Fortran 2008 interfaces) - " + + allocate(hx(Ntot)) + allocate(hx_input(Ntot)) + do i = 1, Ntot + hx(i) = cmplx(dble(i), dble(Ntot - i), kind=8) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, source=hx)) + + ! In-place 2D C2C plan over an Nx*Ny complex double grid; the direction is + ! supplied at exec time rather than at plan creation. + call hipfftCheck(hipfftPlan2d(plan, Nx, Ny, HIPFFT_Z2Z)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + direction = HIPFFT_BACKWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields Ntot times the original input. + do i = 1, Ntot + error = abs(hx(i) - Ntot * hx_input(i)) + if (.not. (error <= error_max * Ntot)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hx(i), " expected=", Ntot * hx_input(i) + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_2d_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f03 b/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f03 new file mode 100644 index 000000000000..7c48d00c5ff1 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f03 @@ -0,0 +1,91 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_3d_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: Nx = 4, Ny = 4, Nz = 8 + integer(c_int), parameter :: Ntot = Nx * Ny * Nz + integer(c_size_t), parameter :: Nbytes = int(Ntot,c_size_t)*8*2 + + type double2 + double precision :: x + double precision :: y + end type double2 + + type(double2), allocatable, target, dimension(:) :: hx, hx_input + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 3D double (z)' (Fortran 2003 interfaces) - " + + allocate(hx(Ntot)) + allocate(hx_input(Ntot)) + do i = 1, Ntot + hx(i)%x = dble(i) + hx(i)%y = dble(Ntot - i) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! In-place 3D C2C plan over an Nx*Ny*Nz complex double volume; the direction + ! is supplied at exec time rather than at plan creation. + call hipfftCheck(hipfftPlan3d(plan, Nx, Ny, Nz, HIPFFT_Z2Z)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_BACKWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields Ntot times the original input. + do i = 1, Ntot + error = abs(hx(i)%x - Ntot * hx_input(i)%x) + abs(hx(i)%y - Ntot * hx_input(i)%y) + if (.not. (error <= error_max * Ntot)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_3d_z diff --git a/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f08 b/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f08 new file mode 100644 index 000000000000..0f303f7eab7b --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f08 @@ -0,0 +1,86 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_c2c_3d_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: Nx = 4, Ny = 4, Nz = 8 + integer(c_int), parameter :: Ntot = Nx * Ny * Nz + + complex(8), allocatable, target, dimension(:) :: hx, hx_input + complex(8), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + integer(c_int) :: direction + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT C2C 3D double (z)' (Fortran 2008 interfaces) - " + + allocate(hx(Ntot)) + allocate(hx_input(Ntot)) + do i = 1, Ntot + hx(i) = cmplx(dble(i), dble(Ntot - i), kind=8) + end do + hx_input(:) = hx(:) + + call hipCheck(hipMalloc(dx, source=hx)) + + ! In-place 3D C2C plan over an Nx*Ny*Nz complex double volume; the direction + ! is supplied at exec time rather than at plan creation. + call hipfftCheck(hipfftPlan3d(plan, Nx, Ny, Nz, HIPFFT_Z2Z)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + direction = HIPFFT_BACKWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields Ntot times the original input. + do i = 1, Ntot + error = abs(hx(i) - Ntot * hx_input(i)) + if (.not. (error <= error_max * Ntot)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hx(i), " expected=", Ntot * hx_input(i) + STOP 1 + end if + end do + + deallocate(hx) + deallocate(hx_input) + + write(*,*) "PASSED!" + +end program hipfft_c2c_3d_z diff --git a/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f03 b/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f03 new file mode 100644 index 000000000000..f2e53c2c8f74 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f03 @@ -0,0 +1,158 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_estimate_getsize_d + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N1d = 32 + integer(c_int), parameter :: Nout = N1d / 2 + 1 ! D2Z output: N/2+1 complex elements + integer(c_int), parameter :: Nx2 = 8, Ny2 = 4 + integer(c_int), parameter :: Nx3 = 4, Ny3 = 4, Nz3 = 2 + integer(c_int), parameter :: one_i = 1 + + integer(c_size_t), parameter :: Nbytes_r = int(N1d, c_size_t) * 8 + integer(c_size_t), parameter :: Nbytes_c = int(Nout, c_size_t) * 16 + + ! Every size output is poisoned first, so a binding that never writes it fails. + integer(c_size_t), parameter :: poison = -12345_c_size_t + + integer(c_size_t) :: workEst, workGS, workTmp + + type(c_ptr) :: plan1d = c_null_ptr + type(c_ptr) :: plan2d = c_null_ptr + type(c_ptr) :: plan3d = c_null_ptr + type(c_ptr) :: dx_r = c_null_ptr + type(c_ptr) :: dx_c = c_null_ptr + + real(c_double), allocatable, target, dimension(:) :: hrx + complex(c_double_complex), allocatable, target, dimension(:) :: hcx + complex(c_double_complex) :: expected + + double precision, parameter :: tol = 1.0d-8 + integer :: i + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT Estimate/GetSize D2Z (d)' (Fortran 2003 interfaces) - " + + ! --- 1D D2Z --- + workEst = poison + workGS = poison + call hipfftCheck(hipfftEstimate1d(N1d, HIPFFT_D2Z, one_i, workEst)) + call hipfftCheck(hipfftCreate(plan1d)) + call hipfftCheck(hipfftMakePlan1d(plan1d, N1d, HIPFFT_D2Z, one_i, workGS)) + call check_sizes("1d", workEst, workGS) + workTmp = poison + call hipfftCheck(hipfftGetSize1d(plan1d, N1d, HIPFFT_D2Z, one_i, workTmp)) + call check_equal("GetSize1d", workTmp, workGS) + workTmp = poison + call hipfftCheck(hipfftGetSize(plan1d, workTmp)) + call check_equal("GetSize", workTmp, workGS) + + ! --- 2D Z2Z --- + workEst = poison + workGS = poison + call hipfftCheck(hipfftEstimate2d(Nx2, Ny2, HIPFFT_Z2Z, workEst)) + call hipfftCheck(hipfftCreate(plan2d)) + call hipfftCheck(hipfftMakePlan2d(plan2d, Nx2, Ny2, HIPFFT_Z2Z, workGS)) + call check_sizes("2d", workEst, workGS) + workTmp = poison + call hipfftCheck(hipfftGetSize2d(plan2d, Nx2, Ny2, HIPFFT_Z2Z, workTmp)) + call check_equal("GetSize2d", workTmp, workGS) + + ! --- 3D Z2Z --- + workEst = poison + workGS = poison + call hipfftCheck(hipfftEstimate3d(Nx3, Ny3, Nz3, HIPFFT_Z2Z, workEst)) + call hipfftCheck(hipfftCreate(plan3d)) + call hipfftCheck(hipfftMakePlan3d(plan3d, Nx3, Ny3, Nz3, HIPFFT_Z2Z, workGS)) + call check_sizes("3d", workEst, workGS) + workTmp = poison + call hipfftCheck(hipfftGetSize3d(plan3d, Nx3, Ny3, Nz3, HIPFFT_Z2Z, workTmp)) + call check_equal("GetSize3d", workTmp, workGS) + + ! --- 1D D2Z transform of all ones: N1d in the DC bin, 0 elsewhere --- + allocate(hrx(N1d), hcx(Nout)) + hrx(:) = 1.0d0 + hcx(:) = cmplx(1.0d30, 1.0d30, kind=c_double_complex) + + call hipCheck(hipMalloc(dx_r, Nbytes_r)) + call hipCheck(hipMalloc(dx_c, Nbytes_c)) + call hipCheck(hipMemcpy(dx_r, c_loc(hrx(1)), Nbytes_r, hipMemcpyHostToDevice)) + call hipCheck(hipMemcpy(dx_c, c_loc(hcx(1)), Nbytes_c, hipMemcpyHostToDevice)) + + call hipfftCheck(hipfftExecD2Z(plan1d, dx_r, dx_c)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan1d)) + call hipfftCheck(hipfftDestroy(plan2d)) + call hipfftCheck(hipfftDestroy(plan3d)) + + call hipCheck(hipMemcpy(c_loc(hcx(1)), dx_c, Nbytes_c, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx_r)) + call hipCheck(hipFree(dx_c)) + + do i = 1, Nout + expected = (0.0d0, 0.0d0) + if (i == 1) expected = cmplx(dble(N1d), 0.0d0, kind=c_double_complex) + if (.not. (abs(hcx(i) - expected) <= tol * N1d)) then + write(*,*) "FAILED! bin ", i - 1, " = ", hcx(i) + STOP 1 + end if + end do + + deallocate(hrx, hcx) + + write(*,*) "PASSED!" + +contains + + ! hipfftEstimate* is an upper bound on the planned work size. + subroutine check_sizes(what, est, gs) + character(*), intent(in) :: what + integer(c_size_t), intent(in) :: est, gs + if (gs == poison .or. gs < 0) then + write(*,*) "FAILED! MakePlan", what, " work size: ", gs + STOP 1 + end if + if (est == poison .or. est < gs) then + write(*,*) "FAILED! Estimate", what, " = ", est, " < MakePlan", what, " = ", gs + STOP 1 + end if + end subroutine check_sizes + + subroutine check_equal(what, got, ref) + character(*), intent(in) :: what + integer(c_size_t), intent(in) :: got, ref + if (got /= ref) then + write(*,*) "FAILED! hipfft", what, " = ", got, ", MakePlan reported ", ref + STOP 1 + end if + end subroutine check_equal + +end program hipfft_estimate_getsize_d diff --git a/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f08 b/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f08 new file mode 100644 index 000000000000..929b3380bed7 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f08 @@ -0,0 +1,182 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_estimate_getsize_d + use iso_c_binding + use hip + use hipfft + + implicit none + + ! hipfftEstimate1d/2d/3d vs hipfftGetSize1d/2d/3d vs hipfftGetSize. + ! Estimate is a pre-plan heuristic upper bound; GetSize* is accurate. + ! (Fortran 2008 interfaces) + + ! Sizes for the three dimension tests. + integer(c_int), parameter :: N1 = 32, Nx2 = 8, Ny2 = 4 + integer(c_int), parameter :: Nx3 = 4, Ny3 = 4, Nz3 = 2 + + ! D2Z real input / complex output for the functional transform check. + integer(c_int), parameter :: Ncomplex = N1 / 2 + 1 + + double precision, parameter :: tol = 1.0d-8 + + real(8), allocatable, target, dimension(:) :: hr + complex(8), allocatable, target, dimension(:) :: hc + real(8), pointer, dimension(:) :: dr => null() + complex(8), pointer, dimension(:) :: dc => null() + type(c_ptr) :: plan = c_null_ptr + ! Every size output is poisoned first, so a binding that never writes it fails. + integer(c_size_t), parameter :: poison = -12345_c_size_t + integer(c_size_t) :: estSz, mkSz, gsSz + integer :: i + double precision :: dc_sum, dc_expected + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT Estimate/GetSize double (d)' (Fortran 2008 interfaces) - " + + ! ----------------------------------------------------------------------- + ! 1-D: HIPFFT_D2Z, N=32, batch=1 + ! ----------------------------------------------------------------------- + estSz = poison + mkSz = poison + call hipfftCheck(hipfftEstimate1d(N1, HIPFFT_D2Z, 1, estSz)) + + call hipfftCheck(hipfftCreate(plan)) + ! hipfftGetSize needs a made plan; hipfftGetSize1d does not configure the handle. + call hipfftCheck(hipfftMakePlan1d(plan, N1, HIPFFT_D2Z, 1, mkSz)) + call check_sizes("1d", estSz, mkSz) + gsSz = poison + call hipfftCheck(hipfftGetSize1d(plan, N1, HIPFFT_D2Z, 1, gsSz)) + call check_equal("GetSize1d", gsSz, mkSz) + gsSz = poison + call hipfftCheck(hipfftGetSize(plan, gsSz)) + call check_equal("GetSize", gsSz, mkSz) + call hipfftCheck(hipfftDestroy(plan)) + + ! ----------------------------------------------------------------------- + ! 2-D: HIPFFT_Z2Z, Nx=8, Ny=4 + ! ----------------------------------------------------------------------- + estSz = poison + mkSz = poison + call hipfftCheck(hipfftEstimate2d(Nx2, Ny2, HIPFFT_Z2Z, estSz)) + + call hipfftCheck(hipfftCreate(plan)) + call hipfftCheck(hipfftMakePlan2d(plan, Nx2, Ny2, HIPFFT_Z2Z, mkSz)) + call check_sizes("2d", estSz, mkSz) + gsSz = poison + call hipfftCheck(hipfftGetSize2d(plan, Nx2, Ny2, HIPFFT_Z2Z, gsSz)) + call check_equal("GetSize2d", gsSz, mkSz) + gsSz = poison + call hipfftCheck(hipfftGetSize(plan, gsSz)) + call check_equal("GetSize", gsSz, mkSz) + call hipfftCheck(hipfftDestroy(plan)) + + ! ----------------------------------------------------------------------- + ! 3-D: HIPFFT_Z2Z, Nx=4, Ny=4, Nz=2 + ! ----------------------------------------------------------------------- + estSz = poison + mkSz = poison + call hipfftCheck(hipfftEstimate3d(Nx3, Ny3, Nz3, HIPFFT_Z2Z, estSz)) + + call hipfftCheck(hipfftCreate(plan)) + call hipfftCheck(hipfftMakePlan3d(plan, Nx3, Ny3, Nz3, HIPFFT_Z2Z, mkSz)) + call check_sizes("3d", estSz, mkSz) + gsSz = poison + call hipfftCheck(hipfftGetSize3d(plan, Nx3, Ny3, Nz3, HIPFFT_Z2Z, gsSz)) + call check_equal("GetSize3d", gsSz, mkSz) + gsSz = poison + call hipfftCheck(hipfftGetSize(plan, gsSz)) + call check_equal("GetSize", gsSz, mkSz) + call hipfftCheck(hipfftDestroy(plan)) + + ! ----------------------------------------------------------------------- + ! Functional check: 1-D D2Z, N=32. DC bin must equal sum(input). + ! ----------------------------------------------------------------------- + allocate(hr(N1)) + allocate(hc(Ncomplex)) + + do i = 1, N1 + hr(i) = dble(i) + dble(mod(i, 5)) * 0.5d0 + end do + ! Poisoned, and copied to the device, so a transform that never writes fails. + hc(:) = cmplx(1.0d30, 1.0d30, kind=8) + + dc_expected = sum(hr) + + call hipCheck(hipMalloc(dr, source=hr)) + call hipCheck(hipMalloc(dc, source=hc)) + + call hipfftCheck(hipfftPlan1d(plan, N1, HIPFFT_D2Z, 1)) + call hipfftCheck(hipfftExecD2Z(plan, dr, dc)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hc, dc, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dr)) + call hipCheck(hipFree(dc)) + + ! DC bin (Fortran index 1) = sum of all input values. + dc_sum = dble(real(hc(1), kind=8)) + if (.not. (abs(dc_sum - dc_expected) <= tol * N1 * abs(dc_expected))) then + write(*,*) "FAILED! DC bin =", dc_sum, " expected =", dc_expected + STOP 1 + end if + if (.not. (abs(aimag(hc(1))) <= tol * N1 * abs(dc_expected))) then + write(*,*) "FAILED! DC imaginary part non-zero:", aimag(hc(1)) + STOP 1 + end if + + deallocate(hr) + deallocate(hc) + + write(*,*) "PASSED!" + +contains + + ! hipfftEstimate* is an upper bound on the planned work size. + subroutine check_sizes(what, est, gs) + character(*), intent(in) :: what + integer(c_size_t), intent(in) :: est, gs + if (gs == poison .or. gs < 0) then + write(*,*) "FAILED! MakePlan", what, " work size: ", gs + STOP 1 + end if + if (est == poison .or. est < gs) then + write(*,*) "FAILED! Estimate", what, " = ", est, " < MakePlan", what, " = ", gs + STOP 1 + end if + end subroutine check_sizes + + subroutine check_equal(what, got, ref) + character(*), intent(in) :: what + integer(c_size_t), intent(in) :: got, ref + if (got /= ref) then + write(*,*) "FAILED! hipfft", what, " = ", got, ", MakePlan reported ", ref + STOP 1 + end if + end subroutine check_equal + +end program hipfft_estimate_getsize_d diff --git a/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f03 b/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f03 new file mode 100644 index 000000000000..485c6a20b3f0 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f03 @@ -0,0 +1,138 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_makeplanmany_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Nbatch = 3 + integer(c_int), parameter :: Ntot = N * Nbatch + integer(c_size_t), parameter :: Nbytes = int(Ntot, c_size_t) * 16 + + integer(c_int), parameter :: rank_i = 1 + integer(c_int), parameter :: one_i = 1 + integer(c_int), parameter :: zero_i = 0 + + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-8 + + ! n/inembed/onembed passed by address to the raw C interface (c_loc) + integer(c_int), target :: nlen(1) + integer(c_int), target :: in_emb(1) + integer(c_int), target :: out_emb(1) + + complex(c_double_complex), allocatable, target, dimension(:) :: hx + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + type(c_ptr) :: workBuf = c_null_ptr + + integer(c_size_t) :: workSize, workSize2 + double precision :: max_error, error + complex(c_double_complex) :: expected + integer :: b, j, pos, kb + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT MakePlanMany 1D batched (z)' (Fortran 2003 interfaces) - " + + nlen(1) = N + in_emb(1) = N + out_emb(1) = N + + allocate(hx(Ntot)) + + ! Batch b holds exp(2*pi*i*kb*j/N) with kb=b+1; forward FFT places N in bin kb. + do b = 0, Nbatch - 1 + kb = b + 1 + do j = 0, N - 1 + pos = b * N + j + hx(pos + 1) = exp(cmplx(0.0d0, 2.0d0 * pi * dble(kb * j) / dble(N), & + kind=c_double_complex)) + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + call hipfftCheck(hipfftCreate(plan)) + ! Disable auto-allocation so we can supply a manual work buffer. + call hipfftCheck(hipfftSetAutoAllocation(plan, zero_i)) + call hipfftCheck(hipfftMakePlanMany(plan, rank_i, c_loc(nlen), & + c_loc(in_emb), one_i, N, c_loc(out_emb), one_i, N, & + HIPFFT_Z2Z, Nbatch, workSize)) + + ! GetSizeMany on the same configured plan must agree with MakePlanMany. + call hipfftCheck(hipfftGetSizeMany(plan, rank_i, c_loc(nlen), & + c_loc(in_emb), one_i, N, c_loc(out_emb), one_i, N, & + HIPFFT_Z2Z, Nbatch, workSize2)) + + if (workSize2 /= workSize) then + write(*,*) "FAILED! workSize mismatch: MakePlanMany=", workSize, & + " GetSizeMany=", workSize2 + STOP 1 + end if + + ! A plan needing no scratch is valid; skip alloc/set in that case. + if (workSize > 0_c_size_t) then + call hipCheck(hipMalloc(workBuf, workSize)) + call hipfftCheck(hipfftSetWorkArea(plan, workBuf)) + end if + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + if (workSize > 0_c_size_t) call hipCheck(hipFree(workBuf)) + + max_error = 0.0d0 + do b = 0, Nbatch - 1 + kb = b + 1 + do j = 0, N - 1 + pos = b * N + j + if (j == kb) then + expected = cmplx(dble(N), 0.0d0, kind=c_double_complex) + else + expected = (0.0d0, 0.0d0) + end if + error = abs(hx(pos + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + + if (.not. (max_error <= tol * N)) then + write(*,*) "FAILED! max error = ", max_error + STOP 1 + end if + + deallocate(hx) + + write(*,*) "PASSED!" + +end program hipfft_makeplanmany_z diff --git a/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f08 b/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f08 new file mode 100644 index 000000000000..e5673eb85878 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f08 @@ -0,0 +1,145 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_makeplanmany_z + use iso_c_binding + use hip + use hipfft + + implicit none + + ! hipfftCreate / hipfftSetAutoAllocation / hipfftMakePlanMany / + ! hipfftGetSizeMany / explicit work buffer / hipfftExecZ2Z + ! (Fortran 2008 interfaces) + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: batch_count = 3 + integer(c_int), parameter :: Ntot = N * batch_count + + ! nlen, inembed_1d, onembed_1d are target so the rank_1 wrapper can c_loc them. + integer(c_int), target :: nlen(1), inembed_1d(1), onembed_1d(1) + ! Non-VALUE scalars for the rank_1 wrappers. + integer(c_int) :: fft_rank, istride_v, idist_v, ostride_v, odist_v, batch_v + integer(kind(HIPFFT_Z2Z)) :: fft_type + + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-8 + + complex(8), allocatable, target, dimension(:) :: hx + complex(8), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + type(c_ptr) :: workbuf = c_null_ptr + integer(c_size_t) :: workSzMake, gSzMany + integer(c_int) :: direction + integer :: b, j, k_exp, pos + complex(8) :: expected + double precision :: error, max_error + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT MakePlanMany Z2Z 1D batched (z)' (Fortran 2008 interfaces) - " + + nlen(1) = N + inembed_1d(1) = N + onembed_1d(1) = N + fft_rank = 1 + istride_v = 1 + idist_v = N + ostride_v = 1 + odist_v = N + batch_v = batch_count + fft_type = HIPFFT_Z2Z + + allocate(hx(Ntot)) + + ! Batch b (0-indexed) holds exp(2*pi*i*(b+1)*j/N), j=0..N-1. + ! Forward transform must place N in bin b+1 (0-indexed) and zero elsewhere. + do b = 0, batch_count - 1 + do j = 0, N - 1 + hx(b * N + j + 1) = exp(cmplx(0.0d0, & + 2.0d0 * pi * dble((b + 1) * j) / dble(N), kind=8)) + end do + end do + + call hipCheck(hipMalloc(dx, source=hx)) + + call hipfftCheck(hipfftCreate(plan)) + call hipfftCheck(hipfftSetAutoAllocation(plan, 0_c_int)) + + ! MakePlanMany configures the plan and returns the required work area size. + call hipfftCheck(hipfftMakePlanMany(plan, fft_rank, nlen, inembed_1d, & + istride_v, idist_v, onembed_1d, ostride_v, odist_v, & + fft_type, batch_v, workSzMake)) + + ! GetSizeMany queries the configured plan; must agree with MakePlanMany. + call hipfftCheck(hipfftGetSizeMany(plan, fft_rank, nlen, inembed_1d, & + istride_v, idist_v, onembed_1d, ostride_v, odist_v, & + fft_type, batch_v, gSzMany)) + + if (gSzMany /= workSzMake) then + write(*,*) "FAILED! GetSizeMany=", gSzMany, " MakePlanMany=", workSzMake + STOP 1 + end if + + ! Provide the work buffer explicitly (auto-alloc was disabled above). + if (workSzMake > 0_c_size_t) then + call hipCheck(hipMalloc(workbuf, workSzMake)) + call hipfftCheck(hipfftSetWorkArea(plan, workbuf)) + end if + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + if (c_associated(workbuf)) call hipCheck(hipFree(workbuf)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + max_error = 0.0d0 + do b = 0, batch_count - 1 + k_exp = b + 1 + do j = 0, N - 1 + pos = b * N + j + if (j == k_exp) then + expected = cmplx(dble(N), 0.0d0, kind=8) + else + expected = (0.0d0, 0.0d0) + end if + error = abs(hx(pos + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + + if (.not. (max_error <= tol * N)) then + write(*,*) "FAILED! max error = ", max_error + STOP 1 + end if + + deallocate(hx) + + write(*,*) "PASSED!" + +end program hipfft_makeplanmany_z diff --git a/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f03 b/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f03 new file mode 100644 index 000000000000..849125b8c494 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f03 @@ -0,0 +1,119 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_planmany_2d_z2z + use iso_c_binding + use hip + use hipfft + + implicit none + + ! Advanced-interface 2D batched C2C transform. The data layout follows the + ! C convention used by hipfftPlanMany: the last dimension (Ny) is contiguous. + integer(c_int), parameter :: rank = 2 + integer(c_int), parameter :: Nx = 4, Ny = 5 + integer(c_int), parameter :: howmany = 3 + integer(c_int), parameter :: Ntot = Nx * Ny + integer(c_size_t), parameter :: Nbytes = int(Ntot,c_size_t) * howmany * 16 + + integer(c_int), target :: n(rank) = [Nx, Ny] + integer(c_int), target :: inembed(rank) = [Nx, Ny] + integer(c_int), target :: onembed(rank) = [Nx, Ny] + integer(c_int), parameter :: istride = 1, ostride = 1 + integer(c_int), parameter :: idist = Nx * Ny, odist = Nx * Ny + + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-8 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx + type(c_ptr) :: dx = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: b, i, j, kx, ky, pos + complex(c_double_complex) :: expected + double precision :: error, max_error + + write(*,"(a)",advance="no") "-- Running test 'hipFFT PlanMany C2C 2D batched (z)' (Fortran 2003 interfaces) - " + + allocate(hx(Ntot * howmany)) + + ! Batch b holds the pure harmonic exp(2*pi*i*(kx*ii/Nx + ky*jj/Ny)) with + ! kx = b mod Nx and ky = (b+1) mod Ny, so the forward transform must place + ! Nx*Ny in bin (kx,ky) of that batch and zero everywhere else. A wrong + ! stride, embed or batch distance moves energy into other bins and fails. + do b = 0, howmany - 1 + kx = mod(b, Nx) + ky = mod(b + 1, Ny) + do i = 0, Nx - 1 + do j = 0, Ny - 1 + pos = b * idist + i * inembed(2) + j + hx(pos + 1) = exp(cmplx(0.0d0, & + 2.0d0 * pi * (dble(kx * i) / dble(Nx) + dble(ky * j) / dble(Ny)), & + kind=c_double_complex)) + end do + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + call hipfftCheck(hipfftPlanMany(plan, rank, c_loc(n), c_loc(inembed), istride, idist, & + c_loc(onembed), ostride, odist, HIPFFT_Z2Z, howmany)) + + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, HIPFFT_FORWARD)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx(1)), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + max_error = 0.0d0 + do b = 0, howmany - 1 + kx = mod(b, Nx) + ky = mod(b + 1, Ny) + do i = 0, Nx - 1 + do j = 0, Ny - 1 + pos = b * odist + i * onembed(2) + j + if (i == kx .and. j == ky) then + expected = cmplx(dble(Ntot), 0.0d0, kind=c_double_complex) + else + expected = (0.0d0, 0.0d0) + end if + error = abs(hx(pos + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + end do + + if (.not. (max_error <= tol * Ntot)) then + write(*,*) "FAILED! max error = ", max_error + STOP 1 + end if + + deallocate(hx) + + write(*,*) "PASSED!" + +end program hipfft_planmany_2d_z2z diff --git a/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f08 b/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f08 new file mode 100644 index 000000000000..c7748a736501 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f08 @@ -0,0 +1,132 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_planmany_2d_z2z + use iso_c_binding + use hip + use hipfft + + implicit none + + ! Advanced-interface 2D batched C2C transform (Fortran 2008 interfaces). + ! Last dimension (Ny) is contiguous, matching C row-major order. + integer(c_int), parameter :: Nx = 4, Ny = 5 + integer(c_int), parameter :: howmany = 3 + integer(c_int), parameter :: Ntot = Nx * Ny + + ! nlen, inembed_a, onembed_a: target arrays passed directly to the rank_1 wrapper. + integer(c_int), target :: nlen(2) + integer(c_int), target :: inembed_a(2) + integer(c_int), target :: onembed_a(2) + ! Scalar plan-many arguments: non-VALUE in the rank_1 wrapper, so use variables. + integer(c_int) :: fft_rank, istride_v, idist_v, ostride_v, odist_v, howmany_v + + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-8 + + complex(8), allocatable, target, dimension(:) :: hx + complex(8), pointer, dimension(:) :: dx => null() + type(c_ptr) :: plan = c_null_ptr + integer(c_int) :: direction + integer :: b, i, j, kx, ky, pos + complex(8) :: expected + double precision :: error, max_error + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT PlanMany C2C 2D batched (z)' (Fortran 2008 interfaces) - " + + nlen = [Nx, Ny] + inembed_a = [Nx, Ny] + onembed_a = [Nx, Ny] + fft_rank = 2 + istride_v = 1 + ostride_v = 1 + idist_v = Nx * Ny + odist_v = Nx * Ny + howmany_v = howmany + + allocate(hx(Ntot * howmany)) + + ! Batch b holds exp(2*pi*i*(kx*ii/Nx + ky*jj/Ny)) with kx=b mod Nx, ky=(b+1) mod Ny. + ! Forward transform must place Nx*Ny in bin (kx,ky) and zero everywhere else. + ! A wrong stride, embed or batch distance moves energy into other bins and fails. + do b = 0, howmany - 1 + kx = mod(b, Nx) + ky = mod(b + 1, Ny) + do i = 0, Nx - 1 + do j = 0, Ny - 1 + pos = b * idist_v + i * inembed_a(2) + j + hx(pos + 1) = exp(cmplx(0.0d0, & + 2.0d0 * pi * (dble(kx * i) / dble(Nx) + dble(ky * j) / dble(Ny)), & + kind=8)) + end do + end do + end do + + call hipCheck(hipMalloc(dx, source=hx)) + + ! The rank_1 wrapper calls c_loc(nlen), c_loc(inembed_a), c_loc(onembed_a) internally; + ! no c_loc here. Non-VALUE scalars must be variables (not literals). + call hipfftCheck(hipfftPlanMany(plan, fft_rank, nlen, inembed_a, & + istride_v, idist_v, onembed_a, ostride_v, odist_v, & + HIPFFT_Z2Z, howmany_v)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) + call hipCheck(hipDeviceSynchronize()) + + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + max_error = 0.0d0 + do b = 0, howmany - 1 + kx = mod(b, Nx) + ky = mod(b + 1, Ny) + do i = 0, Nx - 1 + do j = 0, Ny - 1 + pos = b * odist_v + i * onembed_a(2) + j + if (i == kx .and. j == ky) then + expected = cmplx(dble(Ntot), 0.0d0, kind=8) + else + expected = (0.0d0, 0.0d0) + end if + error = abs(hx(pos + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + end do + + if (.not. (max_error <= tol * Ntot)) then + write(*,*) "FAILED! max error = ", max_error + STOP 1 + end if + + deallocate(hx) + + write(*,*) "PASSED!" + +end program hipfft_planmany_2d_z2z diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f03 b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f03 new file mode 100644 index 000000000000..9f2e6de99dc0 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f03 @@ -0,0 +1,91 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_r2c_c2r_1d_d + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Ncomplex = N/2 + 1 + integer(c_size_t), parameter :: Rbytes = int(N,c_size_t)*8 + integer(c_size_t), parameter :: Cbytes = int(Ncomplex,c_size_t)*8*2 + + real(8), allocatable, target, dimension(:) :: hr, hr_input + type(c_ptr) :: dr = c_null_ptr + type(c_ptr) :: dc = c_null_ptr + type(c_ptr) :: plan_fwd = c_null_ptr + type(c_ptr) :: plan_bwd = c_null_ptr + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT R2C/C2R 1D double (d)' (Fortran 2003 interfaces) - " + + allocate(hr(N)) + allocate(hr_input(N)) + do i = 1, N + hr(i) = dble(i) + dble(mod(i,3)) - dble(mod(i,7)) + end do + hr_input(:) = hr(:) + + call hipCheck(hipMalloc(dr, Rbytes)) + ! The complex (Hermitian) output holds N/2+1 elements due to Hermitian symmetry. + call hipCheck(hipMalloc(dc, Cbytes)) + call hipCheck(hipMemcpy(dr, c_loc(hr(1)), Rbytes, hipMemcpyHostToDevice)) + + ! Forward real-to-complex (out-of-place): dr -> dc. + call hipfftCheck(hipfftPlan1d(plan_fwd, N, HIPFFT_D2Z, 1)) + call hipfftCheck(hipfftExecD2Z(plan_fwd, dr, dc)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_fwd)) + + ! Inverse complex-to-real (out-of-place): dc -> dr. hipFFT unnormalized -> N*input. + call hipfftCheck(hipfftPlan1d(plan_bwd, N, HIPFFT_Z2D, 1)) + call hipfftCheck(hipfftExecZ2D(plan_bwd, dc, dr)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_bwd)) + + call hipCheck(hipMemcpy(c_loc(hr(1)), dr, Rbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dr)) + call hipCheck(hipFree(dc)) + + ! After forward+inverse the real data should equal N times the original input. + do i = 1, N + error = abs(hr(i) - N * hr_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hr) + deallocate(hr_input) + + write(*,*) "PASSED!" + +end program hipfft_r2c_c2r_1d_d diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f08 b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f08 new file mode 100644 index 000000000000..6689836fb3ad --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f08 @@ -0,0 +1,92 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_r2c_c2r_1d_d + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Ncomplex = N/2 + 1 + + real(8), allocatable, target, dimension(:) :: hr, hr_input + complex(8), allocatable, target, dimension(:) :: hc + real(8), pointer, dimension(:) :: dr => null() + complex(8), pointer, dimension(:) :: dc => null() + type(c_ptr) :: plan_fwd = c_null_ptr + type(c_ptr) :: plan_bwd = c_null_ptr + integer :: i + double precision :: error + double precision, parameter :: error_max = 1.0d-8 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT R2C/C2R 1D double (d)' (Fortran 2008 interfaces) - " + + allocate(hr(N)) + allocate(hr_input(N)) + do i = 1, N + hr(i) = dble(i) + dble(mod(i,3)) - dble(mod(i,7)) + end do + hr_input(:) = hr(:) + + ! Device buffers: real input of length N, complex output of length N/2+1. + ! The complex side holds N/2+1 elements due to Hermitian symmetry. + call hipCheck(hipMalloc(dr, source=hr)) + allocate(hc(Ncomplex)) + call hipCheck(hipMalloc(dc, source=hc)) + + ! Forward real-to-complex (out-of-place): dr -> dc. + call hipfftCheck(hipfftPlan1d(plan_fwd, N, HIPFFT_D2Z, 1)) + call hipfftCheck(hipfftExecD2Z(plan_fwd, dr, dc)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_fwd)) + + ! Inverse complex-to-real (out-of-place): dc -> dr. hipFFT unnormalized -> N*input. + call hipfftCheck(hipfftPlan1d(plan_bwd, N, HIPFFT_Z2D, 1)) + call hipfftCheck(hipfftExecZ2D(plan_bwd, dc, dr)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_bwd)) + + call hipCheck(hipMemcpy(hr, dr, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dr)) + call hipCheck(hipFree(dc)) + + ! After forward+inverse the real data should equal N times the original input. + do i = 1, N + error = abs(hr(i) - N * hr_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hr(i), " expected=", N * hr_input(i) + STOP 1 + end if + end do + + deallocate(hr) + deallocate(hr_input) + deallocate(hc) + + write(*,*) "PASSED!" + +end program hipfft_r2c_c2r_1d_d diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f03 b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f03 new file mode 100644 index 000000000000..a2ccf2ea3824 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f03 @@ -0,0 +1,91 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_r2c_c2r_1d_s + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Ncomplex = N/2 + 1 + integer(c_size_t), parameter :: Rbytes = int(N,c_size_t)*4 + integer(c_size_t), parameter :: Cbytes = int(Ncomplex,c_size_t)*4*2 + + real(4), allocatable, target, dimension(:) :: hr, hr_input + type(c_ptr) :: dr = c_null_ptr + type(c_ptr) :: dc = c_null_ptr + type(c_ptr) :: plan_fwd = c_null_ptr + type(c_ptr) :: plan_bwd = c_null_ptr + integer :: i + real :: error + real, parameter :: error_max = 1.0e-4 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT R2C/C2R 1D single (s)' (Fortran 2003 interfaces) - " + + allocate(hr(N)) + allocate(hr_input(N)) + do i = 1, N + hr(i) = real(i) + real(mod(i,3)) - real(mod(i,7)) + end do + hr_input(:) = hr(:) + + call hipCheck(hipMalloc(dr, Rbytes)) + ! The complex (Hermitian) output holds N/2+1 elements due to Hermitian symmetry. + call hipCheck(hipMalloc(dc, Cbytes)) + call hipCheck(hipMemcpy(dr, c_loc(hr(1)), Rbytes, hipMemcpyHostToDevice)) + + ! Forward real-to-complex (out-of-place): dr -> dc. + call hipfftCheck(hipfftPlan1d(plan_fwd, N, HIPFFT_R2C, 1)) + call hipfftCheck(hipfftExecR2C(plan_fwd, dr, dc)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_fwd)) + + ! Inverse complex-to-real (out-of-place): dc -> dr. hipFFT unnormalized -> N*input. + call hipfftCheck(hipfftPlan1d(plan_bwd, N, HIPFFT_C2R, 1)) + call hipfftCheck(hipfftExecC2R(plan_bwd, dc, dr)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_bwd)) + + call hipCheck(hipMemcpy(c_loc(hr(1)), dr, Rbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dr)) + call hipCheck(hipFree(dc)) + + ! After forward+inverse the real data should equal N times the original input. + do i = 1, N + error = abs(hr(i) - N * hr_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error + STOP 1 + end if + end do + + deallocate(hr) + deallocate(hr_input) + + write(*,*) "PASSED!" + +end program hipfft_r2c_c2r_1d_s diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f08 b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f08 new file mode 100644 index 000000000000..8e07b027c183 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f08 @@ -0,0 +1,92 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_r2c_c2r_1d_s + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Ncomplex = N/2 + 1 + + real(4), allocatable, target, dimension(:) :: hr, hr_input + complex(4), allocatable, target, dimension(:) :: hc + real(4), pointer, dimension(:) :: dr => null() + complex(4), pointer, dimension(:) :: dc => null() + type(c_ptr) :: plan_fwd = c_null_ptr + type(c_ptr) :: plan_bwd = c_null_ptr + integer :: i + real :: error + real, parameter :: error_max = 1.0e-4 + + write(*,"(a)",advance="no") "-- Running test 'hipFFT R2C/C2R 1D single (s)' (Fortran 2008 interfaces) - " + + allocate(hr(N)) + allocate(hr_input(N)) + do i = 1, N + hr(i) = real(i) + real(mod(i,3)) - real(mod(i,7)) + end do + hr_input(:) = hr(:) + + ! Device buffers: real input of length N, complex output of length N/2+1. + ! The complex side holds N/2+1 elements due to Hermitian symmetry. + call hipCheck(hipMalloc(dr, source=hr)) + allocate(hc(Ncomplex)) + call hipCheck(hipMalloc(dc, source=hc)) + + ! Forward real-to-complex (out-of-place): dr -> dc. + call hipfftCheck(hipfftPlan1d(plan_fwd, N, HIPFFT_R2C, 1)) + call hipfftCheck(hipfftExecR2C(plan_fwd, dr, dc)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_fwd)) + + ! Inverse complex-to-real (out-of-place): dc -> dr. hipFFT unnormalized -> N*input. + call hipfftCheck(hipfftPlan1d(plan_bwd, N, HIPFFT_C2R, 1)) + call hipfftCheck(hipfftExecC2R(plan_bwd, dc, dr)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan_bwd)) + + call hipCheck(hipMemcpy(hr, dr, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dr)) + call hipCheck(hipFree(dc)) + + ! After forward+inverse the real data should equal N times the original input. + do i = 1, N + error = abs(hr(i) - N * hr_input(i)) + if (.not. (error <= error_max * N)) then + write(*,*) "FAILED! i=", i, " error=", error, " got=", hr(i), " expected=", N * hr_input(i) + STOP 1 + end if + end do + + deallocate(hr) + deallocate(hr_input) + deallocate(hc) + + write(*,*) "PASSED!" + +end program hipfft_r2c_c2r_1d_s diff --git a/projects/hipfft/fortran/test/hipfft_setstream_z.f03 b/projects/hipfft/fortran/test/hipfft_setstream_z.f03 new file mode 100644 index 000000000000..0089a531f424 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_setstream_z.f03 @@ -0,0 +1,127 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_setstream_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 16 + ! Two different harmonics so a swapped-stream bug lands in the wrong bin. + integer(c_int), parameter :: k0 = 3 + integer(c_int), parameter :: k1 = 5 + integer(c_int), parameter :: one_i = 1 + integer(c_size_t), parameter :: Nbytes = int(N, c_size_t) * 16 + + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-8 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx0, hx1 + type(c_ptr) :: dx0 = c_null_ptr + type(c_ptr) :: dx1 = c_null_ptr + type(c_ptr) :: plan0 = c_null_ptr + type(c_ptr) :: plan1 = c_null_ptr + ! hipStreamCreate fills stream0/stream1 by reference (type(c_ptr), no VALUE). + type(c_ptr) :: stream0 = c_null_ptr + type(c_ptr) :: stream1 = c_null_ptr + + double precision :: max_error, error + complex(c_double_complex) :: expected + integer :: j + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT SetStream Z2Z (z)' (Fortran 2003 interfaces) - " + + allocate(hx0(N), hx1(N)) + + do j = 0, N - 1 + hx0(j+1) = exp(cmplx(0.0d0, 2.0d0*pi*dble(k0*j)/dble(N), kind=c_double_complex)) + hx1(j+1) = exp(cmplx(0.0d0, 2.0d0*pi*dble(k1*j)/dble(N), kind=c_double_complex)) + end do + + call hipCheck(hipMalloc(dx0, Nbytes)) + call hipCheck(hipMalloc(dx1, Nbytes)) + call hipCheck(hipMemcpy(dx0, c_loc(hx0(1)), Nbytes, hipMemcpyHostToDevice)) + call hipCheck(hipMemcpy(dx1, c_loc(hx1(1)), Nbytes, hipMemcpyHostToDevice)) + + call hipCheck(hipStreamCreate(stream0)) + call hipCheck(hipStreamCreate(stream1)) + + call hipfftCheck(hipfftPlan1d(plan0, N, HIPFFT_Z2Z, one_i)) + call hipfftCheck(hipfftPlan1d(plan1, N, HIPFFT_Z2Z, one_i)) + + ! hipfftSetStream takes stream by value (type(c_ptr),value). + call hipfftCheck(hipfftSetStream(plan0, stream0)) + call hipfftCheck(hipfftSetStream(plan1, stream1)) + + call hipfftCheck(hipfftExecZ2Z(plan0, dx0, dx0, HIPFFT_FORWARD)) + call hipfftCheck(hipfftExecZ2Z(plan1, dx1, dx1, HIPFFT_FORWARD)) + + ! Synchronise each stream individually — this is what is under test. + call hipCheck(hipStreamSynchronize(stream0)) + call hipCheck(hipStreamSynchronize(stream1)) + + call hipCheck(hipMemcpy(c_loc(hx0(1)), dx0, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipMemcpy(c_loc(hx1(1)), dx1, Nbytes, hipMemcpyDeviceToHost)) + + call hipfftCheck(hipfftDestroy(plan0)) + call hipfftCheck(hipfftDestroy(plan1)) + call hipCheck(hipStreamDestroy(stream0)) + call hipCheck(hipStreamDestroy(stream1)) + call hipCheck(hipFree(dx0)) + call hipCheck(hipFree(dx1)) + + max_error = 0.0d0 + do j = 0, N - 1 + if (j == k0) then + expected = cmplx(dble(N), 0.0d0, kind=c_double_complex) + else + expected = (0.0d0, 0.0d0) + end if + error = abs(hx0(j+1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + do j = 0, N - 1 + if (j == k1) then + expected = cmplx(dble(N), 0.0d0, kind=c_double_complex) + else + expected = (0.0d0, 0.0d0) + end if + error = abs(hx1(j+1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + if (.not. (max_error <= tol * N)) then + write(*,*) "FAILED! max error = ", max_error + STOP 1 + end if + + deallocate(hx0, hx1) + + write(*,*) "PASSED!" + +end program hipfft_setstream_z diff --git a/projects/hipfft/fortran/test/hipfft_setstream_z.f08 b/projects/hipfft/fortran/test/hipfft_setstream_z.f08 new file mode 100644 index 000000000000..6f1f4e718c97 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_setstream_z.f08 @@ -0,0 +1,136 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_setstream_z + use iso_c_binding + use hip + use hipfft + + implicit none + + ! Two 1-D Z2Z plans bound to different HIP streams, different input harmonics. + ! A swapped stream would place energy in the wrong bin and fail verification. + ! (Fortran 2008 interfaces) + integer(c_int), parameter :: N = 16 + + ! Distinct harmonics so a stream swap is observable in both buffers. + integer, parameter :: k1 = 3, k2 = 7 + + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-8 + + complex(8), allocatable, target, dimension(:) :: hx1, hx2 + complex(8), pointer, dimension(:) :: dx1 => null(), dx2 => null() + type(c_ptr) :: plan1 = c_null_ptr, plan2 = c_null_ptr + type(c_ptr) :: stream1 = c_null_ptr, stream2 = c_null_ptr + integer(c_int) :: direction + integer :: j + double precision :: error, max_error + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT SetStream Z2Z 1D (z)' (Fortran 2008 interfaces) - " + + allocate(hx1(N)) + allocate(hx2(N)) + + ! Buffer 1: pure harmonic at bin k1 (0-indexed). + do j = 0, N - 1 + hx1(j + 1) = exp(cmplx(0.0d0, 2.0d0 * pi * dble(k1 * j) / dble(N), kind=8)) + end do + + ! Buffer 2: pure harmonic at bin k2 (0-indexed). + do j = 0, N - 1 + hx2(j + 1) = exp(cmplx(0.0d0, 2.0d0 * pi * dble(k2 * j) / dble(N), kind=8)) + end do + + call hipCheck(hipMalloc(dx1, source=hx1)) + call hipCheck(hipMalloc(dx2, source=hx2)) + + call hipCheck(hipStreamCreate(stream1)) + call hipCheck(hipStreamCreate(stream2)) + + call hipfftCheck(hipfftPlan1d(plan1, N, HIPFFT_Z2Z, 1)) + call hipfftCheck(hipfftPlan1d(plan2, N, HIPFFT_Z2Z, 1)) + + call hipfftCheck(hipfftSetStream(plan1, stream1)) + call hipfftCheck(hipfftSetStream(plan2, stream2)) + + direction = HIPFFT_FORWARD + call hipfftCheck(hipfftExecZ2Z(plan1, dx1, dx1, direction)) + call hipfftCheck(hipfftExecZ2Z(plan2, dx2, dx2, direction)) + + ! Synchronize each stream independently (not hipDeviceSynchronize). + call hipCheck(hipStreamSynchronize(stream1)) + call hipCheck(hipStreamSynchronize(stream2)) + + call hipfftCheck(hipfftDestroy(plan1)) + call hipfftCheck(hipfftDestroy(plan2)) + + call hipCheck(hipMemcpy(hx1, dx1, hipMemcpyDeviceToHost)) + call hipCheck(hipMemcpy(hx2, dx2, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx1)) + call hipCheck(hipFree(dx2)) + + call hipCheck(hipStreamDestroy(stream1)) + call hipCheck(hipStreamDestroy(stream2)) + + ! Verify buffer 1: energy only at Fortran index k1+1 (0-indexed bin k1). + max_error = 0.0d0 + do j = 1, N + if (j == k1 + 1) then + error = abs(hx1(j) - cmplx(dble(N), 0.0d0, kind=8)) + else + error = abs(hx1(j)) + end if + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + if (.not. (max_error <= tol * N)) then + write(*,*) "FAILED! buffer1 max error = ", max_error + STOP 1 + end if + + ! Verify buffer 2: energy only at Fortran index k2+1 (0-indexed bin k2). + max_error = 0.0d0 + do j = 1, N + if (j == k2 + 1) then + error = abs(hx2(j) - cmplx(dble(N), 0.0d0, kind=8)) + else + error = abs(hx2(j)) + end if + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + if (.not. (max_error <= tol * N)) then + write(*,*) "FAILED! buffer2 max error = ", max_error + STOP 1 + end if + + deallocate(hx1) + deallocate(hx2) + + write(*,*) "PASSED!" + +end program hipfft_setstream_z diff --git a/projects/hipfft/fortran/test/hipfft_version.f03 b/projects/hipfft/fortran/test/hipfft_version.f03 new file mode 100644 index 000000000000..f1e0a7bd8ed1 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_version.f03 @@ -0,0 +1,84 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Both calls report the backend's version, so this checks the +! binding: outputs are poisoned, and the packed code must match the triple. +program hipfft_version + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: poison = -12345 + + integer(c_int) :: version, major, minor, patch + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT version query' - " + + version = poison + major = poison + minor = poison + patch = poison + + ! Output scalar passed directly: the dummy is "integer(c_int) :: version". + call hipfftCheck(hipfftGetVersion(version)) + + call hipfftCheck(hipfftGetProperty(HIPFFT_MAJOR_VERSION, major)) + call hipfftCheck(hipfftGetProperty(HIPFFT_MINOR_VERSION, minor)) + call hipfftCheck(hipfftGetProperty(HIPFFT_PATCH_LEVEL, patch)) + + if (version == poison) then + write(*,*) "FAILED! hipfftGetVersion did not write its output argument" + STOP 1 + end if + + if (major == poison .or. minor == poison .or. patch == poison) then + write(*,*) "FAILED! hipfftGetProperty did not write its output argument" + STOP 1 + end if + + if (version <= 0) then + write(*,*) "FAILED! implausible backend version code: ", version + STOP 1 + end if + + if (major < 1 .or. minor < 0 .or. patch < 0) then + write(*,*) "FAILED! implausible backend version triple: ", major, minor, patch + STOP 1 + end if + + ! The code packs major*10000 + minor*100 + patch. + if (version /= major * 10000 + minor * 100 + patch) then + write(*,*) "FAILED! hipfftGetVersion code ", version, & + " disagrees with hipfftGetProperty triple ", major, minor, patch + STOP 1 + end if + + write(*,"(a,i0,a,i0,a,i0,a,i0,a)") "PASSED! backend FFT library version: ", & + major, ".", minor, ".", patch, " (code ", version, ")" + +end program hipfft_version diff --git a/projects/hipfft/fortran/test/hipfft_version.f08 b/projects/hipfft/fortran/test/hipfft_version.f08 new file mode 100644 index 000000000000..338b0752f4e7 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_version.f08 @@ -0,0 +1,84 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Both calls report the backend's version, so this checks the +! binding: outputs are poisoned, and the packed code must match the triple. +program hipfft_version + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: poison = -12345 + + integer(c_int) :: version, major, minor, patch + + write(*,"(a)",advance="no") & + "-- Running test 'hipFFT version query' (Fortran 2008 interfaces) - " + + version = poison + major = poison + minor = poison + patch = poison + + ! Output scalar passed directly: the dummy is "integer(c_int) :: version". + call hipfftCheck(hipfftGetVersion(version)) + + call hipfftCheck(hipfftGetProperty(HIPFFT_MAJOR_VERSION, major)) + call hipfftCheck(hipfftGetProperty(HIPFFT_MINOR_VERSION, minor)) + call hipfftCheck(hipfftGetProperty(HIPFFT_PATCH_LEVEL, patch)) + + if (version == poison) then + write(*,*) "FAILED! hipfftGetVersion did not write its output argument" + STOP 1 + end if + + if (major == poison .or. minor == poison .or. patch == poison) then + write(*,*) "FAILED! hipfftGetProperty did not write its output argument" + STOP 1 + end if + + if (version <= 0) then + write(*,*) "FAILED! implausible backend version code: ", version + STOP 1 + end if + + if (major < 1 .or. minor < 0 .or. patch < 0) then + write(*,*) "FAILED! implausible backend version triple: ", major, minor, patch + STOP 1 + end if + + ! The code packs major*10000 + minor*100 + patch. + if (version /= major * 10000 + minor * 100 + patch) then + write(*,*) "FAILED! hipfftGetVersion code ", version, & + " disagrees with hipfftGetProperty triple ", major, minor, patch + STOP 1 + end if + + write(*,"(a,i0,a,i0,a,i0,a,i0,a)") "PASSED! backend FFT library version: ", & + major, ".", minor, ".", patch, " (code ", version, ")" + +end program hipfft_version diff --git a/projects/hipfft/fortran/test/hipfft_xt_descriptor_z.f03 b/projects/hipfft/fortran/test/hipfft_xt_descriptor_z.f03 new file mode 100644 index 000000000000..634191b815df --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_xt_descriptor_z.f03 @@ -0,0 +1,101 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_xt_descriptor_z + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: NX = 16, NY = 16 + double precision, parameter :: error_max = 1.0d-10 + + complex(c_double_complex), target :: hx(NX, NY), hx_input(NX, NY) + integer(c_int), target :: gpus(2) + type(c_ptr) :: plan = c_null_ptr + type(c_ptr) :: d = c_null_ptr + type(hipLibXtDesc), pointer :: desc + type(hipXtDesc), pointer :: xt + integer(c_size_t), target :: work(2) ! one work size per GPU + integer(c_int) :: ndev + integer :: i, j + double precision :: error + + write(*,"(a)",advance="no") "-- Running test 'hipFFT Xt descriptor 2D Z2Z' (Fortran 2003 interfaces) - " + + ! The descriptor API needs a plan spread over at least two GPUs. + call hipCheck(hipGetDeviceCount(ndev)) + ! Exit 77, which CTest reports as skipped: nothing was checked. + if (ndev < 2) then + write(*,*) "SKIPPED (needs two GPUs, found ", ndev, ")" + stop 77 + end if + + do j = 1, NY + do i = 1, NX + hx(i, j) = cmplx(dble(i + j), dble(NX - i), c_double_complex) + end do + end do + hx_input = hx + + gpus = [0, 1] + call hipfftCheck(hipfftCreate(plan)) + call hipfftCheck(hipfftXtSetGPUs(plan, 2, c_loc(gpus))) + ! A multi-GPU plan writes one work size per GPU: pass c_loc of an array with + ! one slot per GPU to the type(c_ptr) form. + call hipfftCheck(hipfftMakePlan2d(plan, NY, NX, HIPFFT_Z2Z, c_loc(work))) + + ! hipFFT allocates and owns the descriptor: keep its address, and pass the + ! pointer that c_f_pointer associates with it, never a copy of the type. + call hipfftCheck(hipfftXtMalloc(plan, d, HIPFFT_XT_FORMAT_INPLACE)) + call c_f_pointer(d, desc) + call c_f_pointer(desc%descriptor, xt) + if (xt%nGPUs /= 2) then + write(*,*) "FAILED! descriptor spans ", xt%nGPUs, " GPUs (expected 2)" + call exit(1) + end if + + call hipfftCheck(hipfftXtMemcpy(plan, d, c_loc(hx), HIPFFT_COPY_HOST_TO_DEVICE)) + call hipfftCheck(hipfftXtExecDescriptorZ2Z(plan, desc, desc, HIPFFT_FORWARD)) + call hipfftCheck(hipfftXtExecDescriptorZ2Z(plan, desc, desc, HIPFFT_BACKWARD)) + call hipfftCheck(hipfftXtMemcpy(plan, c_loc(hx), d, HIPFFT_COPY_DEVICE_TO_HOST)) + call hipfftCheck(hipfftXtFree(desc)) + call hipfftCheck(hipfftDestroy(plan)) + + ! hipFFT is unnormalized, so forward+inverse yields NX*NY times the input. + do j = 1, NY + do i = 1, NX + error = abs(hx(i, j) - NX * NY * hx_input(i, j)) / (NX * NY * max(1.0d0, abs(hx_input(i, j)))) + if (.not. (error <= error_max)) then + write(*,*) "FAILED! i=", i, " j=", j, " error=", error + call exit(1) + end if + end do + end do + + write(*,*) "PASSED!" + +end program hipfft_xt_descriptor_z diff --git a/projects/hipfft/fortran/test/hipfft_xt_makeplanmany_c.f03 b/projects/hipfft/fortran/test/hipfft_xt_makeplanmany_c.f03 new file mode 100644 index 000000000000..012cf75a2706 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfft_xt_makeplanmany_c.f03 @@ -0,0 +1,88 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfft_xt_makeplanmany_c + use iso_c_binding + use hip + use hipfft + + implicit none + + integer(c_int), parameter :: N = 32, batch = 3 + integer(c_size_t), parameter :: Nbytes = int(N,c_size_t) * int(batch,c_size_t) * 8 + real, parameter :: error_max = 1.0e-5 + + complex(c_float_complex), target :: hx(N, batch), hx_input(N, batch) + integer(c_int64_t), target :: nn(1) + type(c_ptr) :: plan = c_null_ptr + type(c_ptr) :: dx = c_null_ptr + integer(c_size_t) :: work, work_query + integer :: i, b + real :: error + + write(*,"(a)",advance="no") "-- Running test 'hipFFT XtMakePlanMany C2C' (Fortran 2003 interfaces) - " + + do b = 1, batch + do i = 1, N + hx(i, b) = cmplx(real(i + b), real(N - i), c_float_complex) + end do + end do + hx_input = hx + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx), Nbytes, hipMemcpyHostToDevice)) + + ! The Xt plan names its data types (hipDataType) instead of an hipfftType. + nn(1) = N + call hipfftCheck(hipfftCreate(plan)) + call hipfftCheck(hipfftXtGetSizeMany(plan, 1, c_loc(nn), c_null_ptr, 1_c_int64_t, & + int(N,c_int64_t), HIP_C_32F, c_null_ptr, 1_c_int64_t, int(N,c_int64_t), HIP_C_32F, & + int(batch,c_int64_t), work_query, HIP_C_32F)) + call hipfftCheck(hipfftXtMakePlanMany(plan, 1, c_loc(nn), c_null_ptr, 1_c_int64_t, & + int(N,c_int64_t), HIP_C_32F, c_null_ptr, 1_c_int64_t, int(N,c_int64_t), HIP_C_32F, & + int(batch,c_int64_t), work, HIP_C_32F)) + + call hipfftCheck(hipfftXtExec(plan, dx, dx, HIPFFT_FORWARD)) + call hipfftCheck(hipfftXtExec(plan, dx, dx, HIPFFT_BACKWARD)) + call hipCheck(hipDeviceSynchronize()) + call hipfftCheck(hipfftDestroy(plan)) + + call hipCheck(hipMemcpy(c_loc(hx), dx, Nbytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + + ! hipFFT is unnormalized, so forward+inverse yields N times the original input. + do b = 1, batch + do i = 1, N + error = abs(hx(i, b) - N * hx_input(i, b)) / (N * max(1.0, abs(hx_input(i, b)))) + if (.not. (error <= error_max)) then + write(*,*) "FAILED! i=", i, " b=", b, " error=", error + call exit(1) + end if + end do + end do + + write(*,*) "PASSED!" + +end program hipfft_xt_makeplanmany_c diff --git a/projects/hipfft/fortran/test/hipfftw_alloc.f03 b/projects/hipfft/fortran/test/hipfftw_alloc.f03 new file mode 100644 index 000000000000..205d72bd91cc --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_alloc.f03 @@ -0,0 +1,132 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! hipFFTW allocation API: fftw_alloc_real / fftw_alloc_complex and their +! single-precision counterparts return host-accessible buffers that can be +! handed straight to a plan, mirroring the allocation tests in +! clients/tests/hipfftw_test.cpp. +program hipfftw_alloc_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Nc = N / 2 + 1 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-12 + real, parameter :: tol_s = 1.0e-4 + + type(c_ptr) :: pr = c_null_ptr, pc = c_null_ptr, plan = c_null_ptr + real(c_double), pointer :: x(:) => null() + complex(c_double_complex), pointer :: y(:) => null() + real(c_float), pointer :: xs(:) => null() + complex(c_float_complex), pointer :: ys(:) => null() + integer :: j + double precision :: error, max_error + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_alloc' (Fortran 2003) - " + + ! Real signal: x[j] = 1 + 2*cos(2*pi*j/N) + 3*cos(2*pi*3*j/N) + ! R2C output (0-indexed): X[0] = N, X[1] = N, X[3] = 3*N/2, rest zero. + pr = fftw_alloc_real(int(N, c_size_t)) + pc = fftw_alloc_complex(int(Nc, c_size_t)) + if (.not. c_associated(pr) .or. .not. c_associated(pc)) then + write(*,*) "FAILED! fftw_alloc_real/fftw_alloc_complex returned a null pointer" + call exit(1) + end if + + call c_f_pointer(pr, x, [N]) + call c_f_pointer(pc, y, [Nc]) + do j = 0, N-1 + x(j+1) = 1.0d0 + 2.0d0 * cos(2.0d0 * pi * j / dble(N)) & + + 3.0d0 * cos(6.0d0 * pi * j / dble(N)) + end do + + plan = fftw_plan_dft_r2c_1d(N, pr, pc, FFTW_ESTIMATE) + call fftw_execute_dft_r2c(plan, pr, pc) + call fftw_destroy_plan(plan) + + max_error = 0.0d0 + do j = 0, Nc-1 + if (j == 0 .or. j == 1) then + error = abs(y(j+1) - cmplx(dble(N), 0.0d0, kind=c_double_complex)) + else if (j == 3) then + error = abs(y(j+1) - cmplx(1.5d0 * N, 0.0d0, kind=c_double_complex)) + else + error = abs(y(j+1)) + end if + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + call fftw_free(pr) + call fftw_free(pc) + + if (.not. (max_error <= tol)) then + write(*,*) "FAILED! double precision: max error = ", max_error + call exit(1) + end if + + pr = fftwf_alloc_real(int(N, c_size_t)) + pc = fftwf_alloc_complex(int(Nc, c_size_t)) + if (.not. c_associated(pr) .or. .not. c_associated(pc)) then + write(*,*) "FAILED! fftwf_alloc_real/fftwf_alloc_complex returned a null pointer" + call exit(1) + end if + + call c_f_pointer(pr, xs, [N]) + call c_f_pointer(pc, ys, [Nc]) + do j = 0, N-1 + xs(j+1) = real(1.0d0 + 2.0d0 * cos(2.0d0 * pi * j / dble(N)) & + + 3.0d0 * cos(6.0d0 * pi * j / dble(N)), c_float) + end do + + plan = fftwf_plan_dft_r2c_1d(N, pr, pc, FFTW_ESTIMATE) + call fftwf_execute_dft_r2c(plan, pr, pc) + call fftwf_destroy_plan(plan) + + max_error = 0.0d0 + do j = 0, Nc-1 + if (j == 0 .or. j == 1) then + error = abs(ys(j+1) - cmplx(real(N), 0.0, kind=c_float_complex)) + else if (j == 3) then + error = abs(ys(j+1) - cmplx(1.5 * N, 0.0, kind=c_float_complex)) + else + error = abs(ys(j+1)) + end if + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + call fftwf_free(pr) + call fftwf_free(pc) + + if (.not. (max_error <= tol_s)) then + write(*,*) "FAILED! single precision: max error = ", max_error + call exit(1) + end if + + write(*,*) "PASSED!" +end program hipfftw_alloc_test diff --git a/projects/hipfft/fortran/test/hipfftw_c2c.f03 b/projects/hipfft/fortran/test/hipfftw_c2c.f03 new file mode 100644 index 000000000000..8c503336d3a7 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_c2c.f03 @@ -0,0 +1,88 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfftw_c2c_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_size_t), parameter :: Nbytes = N * 16 ! sizeof(double complex) = 16 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-12 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx, hresult + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: j + double precision :: error, max_error + complex(c_double_complex) :: w + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_c2c' (Fortran 2003) - " + + ! Signal: x[j] = exp(2*pi*i*1*j/N) + 2*exp(2*pi*i*5*j/N) + ! Expected DFT: X[1]=N, X[5]=2*N, all other bins zero (0-indexed) + w = cmplx(0.0d0, 2.0d0 * pi / dble(N), kind=c_double_complex) + allocate(hx(N), hresult(N)) + do j = 0, N-1 + hx(j+1) = exp(w * dble(j)) + 2.0d0 * exp(5.0d0 * w * dble(j)) + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMalloc(dy, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! Device pointers pass directly to the FFTW C API (in/out are void*). + plan = fftw_plan_dft_1d(N, dx, dy, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, Nbytes, hipMemcpyDeviceToHost)) + + max_error = 0.0d0 + do j = 0, N-1 + if (j == 1) then + error = abs(hresult(j+1) - cmplx(dble(N), 0.0d0, kind=c_double_complex)) + else if (j == 5) then + error = abs(hresult(j+1) - cmplx(2.0d0 * N, 0.0d0, kind=c_double_complex)) + else + error = abs(hresult(j+1)) + end if + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + if (.not. (max_error <= tol)) then + write(*,*) "FAILED! max error = ", max_error + call exit(1) + end if + + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult) + + write(*,*) "PASSED!" +end program hipfftw_c2c_test diff --git a/projects/hipfft/fortran/test/hipfftw_dft_2d.f03 b/projects/hipfft/fortran/test/hipfftw_dft_2d.f03 new file mode 100644 index 000000000000..b314b01fcbd0 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_dft_2d.f03 @@ -0,0 +1,95 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfftw_dft_2d_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: NX = 4, NY = 8 + integer(c_int), parameter :: kx = 1, ky = 3 + integer(c_size_t), parameter :: Nbytes = NX * NY * 16 ! sizeof(double complex) = 16 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-10 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx, hresult + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: ii, jj, kxi, kyi + double precision :: error, max_error + complex(c_double_complex) :: wx, wy, expected + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_dft_2d' (Fortran 2003) - " + + ! Signal: h[ii,jj] = exp(2*pi*i*(kx*ii/NX + ky*jj/NY)), C row-major (jj contiguous). + ! Linear index: ii*NY + jj (0-indexed). + ! Expected 2D DFT: output bin (kx,ky) = NX*NY, all others zero. + wx = cmplx(0.0d0, 2.0d0 * pi * dble(kx) / dble(NX), kind=c_double_complex) + wy = cmplx(0.0d0, 2.0d0 * pi * dble(ky) / dble(NY), kind=c_double_complex) + allocate(hx(NX*NY), hresult(NX*NY)) + do ii = 0, NX-1 + do jj = 0, NY-1 + hx(ii*NY + jj + 1) = exp(wx*dble(ii)) * exp(wy*dble(jj)) + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMalloc(dy, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! n0=NX (slow), n1=NY (fast); C row-major, no dimension reversal needed. + plan = fftw_plan_dft_2d(NX, NY, dx, dy, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, Nbytes, hipMemcpyDeviceToHost)) + + ! Verify: output bin (kx,ky) should equal NX*NY; all others zero. + max_error = 0.0d0 + do kxi = 0, NX-1 + do kyi = 0, NY-1 + if (kxi == kx .and. kyi == ky) then + expected = cmplx(dble(NX*NY), 0.0d0, kind=c_double_complex) + else + expected = cmplx(0.0d0, 0.0d0, kind=c_double_complex) + end if + error = abs(hresult(kxi*NY + kyi + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + + if (.not. (max_error <= tol * dble(NX*NY))) then + write(*,*) "FAILED! max error = ", max_error + call exit(1) + end if + + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult) + + write(*,*) "PASSED!" +end program hipfftw_dft_2d_test diff --git a/projects/hipfft/fortran/test/hipfftw_dft_3d.f03 b/projects/hipfft/fortran/test/hipfftw_dft_3d.f03 new file mode 100644 index 000000000000..097b945e9ec2 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_dft_3d.f03 @@ -0,0 +1,101 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfftw_dft_3d_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: NX = 4, NY = 4, NZ = 2 + integer(c_int), parameter :: kx = 1, ky = 2, kz = 1 + integer(c_size_t), parameter :: Nbytes = NX * NY * NZ * 16 ! sizeof(double complex) = 16 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-10 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx, hresult + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: ix, iy, iz, kxi, kyi, kzi + double precision :: error, max_error + complex(c_double_complex) :: wx, wy, wz, expected + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_dft_3d' (Fortran 2003) - " + + ! Signal: h[ix,iy,iz] = exp(2*pi*i*(kx*ix/NX + ky*iy/NY + kz*iz/NZ)). + ! Layout: C row-major, NZ contiguous. Index: ix*NY*NZ + iy*NZ + iz (0-indexed). + ! Expected 3D DFT: output bin (kx,ky,kz) = NX*NY*NZ, all others zero. + wx = cmplx(0.0d0, 2.0d0 * pi * dble(kx) / dble(NX), kind=c_double_complex) + wy = cmplx(0.0d0, 2.0d0 * pi * dble(ky) / dble(NY), kind=c_double_complex) + wz = cmplx(0.0d0, 2.0d0 * pi * dble(kz) / dble(NZ), kind=c_double_complex) + allocate(hx(NX*NY*NZ), hresult(NX*NY*NZ)) + do ix = 0, NX-1 + do iy = 0, NY-1 + do iz = 0, NZ-1 + hx(ix*NY*NZ + iy*NZ + iz + 1) = & + exp(wx*dble(ix)) * exp(wy*dble(iy)) * exp(wz*dble(iz)) + end do + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMalloc(dy, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + ! n0=NX (slowest), n1=NY, n2=NZ (fastest); C row-major, no reversal needed. + plan = fftw_plan_dft_3d(NX, NY, NZ, dx, dy, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, Nbytes, hipMemcpyDeviceToHost)) + + ! Verify: output bin (kx,ky,kz) should equal NX*NY*NZ; all others zero. + max_error = 0.0d0 + do kxi = 0, NX-1 + do kyi = 0, NY-1 + do kzi = 0, NZ-1 + if (kxi == kx .and. kyi == ky .and. kzi == kz) then + expected = cmplx(dble(NX*NY*NZ), 0.0d0, kind=c_double_complex) + else + expected = cmplx(0.0d0, 0.0d0, kind=c_double_complex) + end if + error = abs(hresult(kxi*NY*NZ + kyi*NZ + kzi + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + end do + + if (.not. (max_error <= tol * dble(NX*NY*NZ))) then + write(*,*) "FAILED! max error = ", max_error + call exit(1) + end if + + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult) + + write(*,*) "PASSED!" +end program hipfftw_dft_3d_test diff --git a/projects/hipfft/fortran/test/hipfftw_guru.f03 b/projects/hipfft/fortran/test/hipfftw_guru.f03 new file mode 100644 index 000000000000..131ea5d19481 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_guru.f03 @@ -0,0 +1,137 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfftw_guru_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: N = 16, HOWMANY = 3 + integer(c_size_t), parameter :: Nbytes = N * HOWMANY * 16 ! sizeof(double complex) = 16 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-10, tol_s = 1.0d-5 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx, hresult + complex(c_float_complex), allocatable, target, dimension(:) :: hxs, hresults + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + type(fftw_iodim) :: dims(1), howmany_dims(1) + integer :: b, j, k + double precision :: error, max_error + complex(c_double_complex) :: w, expected + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_guru' (Fortran 2003) - " + + ! 1D batched C2C: HOWMANY batches of length N, contiguous (stride=1, dist=N). + ! Batch b (0-indexed): x[j] = exp(2*pi*i*(b+1)*j/N). + ! Expected forward DFT: output bin b+1 of batch b = N, all others zero. + allocate(hx(N*HOWMANY), hresult(N*HOWMANY)) + do b = 0, HOWMANY-1 + w = cmplx(0.0d0, 2.0d0 * pi * dble(b+1) / dble(N), kind=c_double_complex) + do j = 0, N-1 + hx(b*N + j + 1) = exp(w * dble(j)) + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMalloc(dy, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + dims(1) = fftw_iodim(N, 1, 1) ! n=N, is=1, os=1 + howmany_dims(1) = fftw_iodim(HOWMANY, N, N) ! n=HOWMANY, is=N, os=N + ! dims and howmany_dims are arrays of rank and howmany_rank fftw_iodim; the + ! dummies are assumed-size type(fftw_iodim) :: dims(*), so pass the arrays. + ! The fftwf_ planner below takes the same arrays (fftwf_iodim is fftw_iodim). + plan = fftw_plan_guru_dft(1, dims, 1, howmany_dims, & + dx, dy, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, Nbytes, hipMemcpyDeviceToHost)) + + ! Verify: for batch b, output bin b+1 should equal N; all others zero. + max_error = 0.0d0 + do b = 0, HOWMANY-1 + do k = 0, N-1 + if (k == b+1) then + expected = cmplx(dble(N), 0.0d0, kind=c_double_complex) + else + expected = cmplx(0.0d0, 0.0d0, kind=c_double_complex) + end if + error = abs(hresult(b*N + k + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + + if (.not. (max_error <= tol * dble(N))) then + write(*,*) "FAILED! max error = ", max_error + call exit(1) + end if + + ! Same transform in single precision through fftwf_plan_guru_dft. The buffers + ! are reused: the single-precision data takes half the bytes. + allocate(hxs(N*HOWMANY), hresults(N*HOWMANY)) + hxs = cmplx(hx, kind=c_float_complex) + hresults = cmplx(-1.0, -1.0, kind=c_float_complex) + call hipCheck(hipMemcpy(dx, c_loc(hxs(1)), Nbytes / 2, hipMemcpyHostToDevice)) + call hipCheck(hipMemcpy(dy, c_loc(hresults(1)), Nbytes / 2, hipMemcpyHostToDevice)) + + plan = fftwf_plan_guru_dft(1, dims, 1, howmany_dims, & + dx, dy, FFTW_FORWARD, FFTW_ESTIMATE) + if (.not. c_associated(plan)) then + write(*,*) "FAILED! fftwf_plan_guru_dft returned a null plan" + call exit(1) + end if + call fftwf_execute_dft(plan, dx, dy) + call fftwf_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresults(1)), dy, Nbytes / 2, hipMemcpyDeviceToHost)) + + max_error = 0.0d0 + do b = 0, HOWMANY-1 + do k = 0, N-1 + if (k == b+1) then + expected = cmplx(dble(N), 0.0d0, kind=c_double_complex) + else + expected = cmplx(0.0d0, 0.0d0, kind=c_double_complex) + end if + error = abs(cmplx(hresults(b*N + k + 1), kind=c_double_complex) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + + if (.not. (max_error <= tol_s * dble(N))) then + write(*,*) "FAILED! single-precision max error = ", max_error + call exit(1) + end if + + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult, hxs, hresults) + + write(*,*) "PASSED!" +end program hipfftw_guru_test diff --git a/projects/hipfft/fortran/test/hipfftw_guru64.f03 b/projects/hipfft/fortran/test/hipfftw_guru64.f03 new file mode 100644 index 000000000000..945d312780f4 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_guru64.f03 @@ -0,0 +1,96 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfftw_guru64_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: N = 16, HOWMANY = 3 + integer(c_size_t), parameter :: Nbytes = N * HOWMANY * 16 ! sizeof(double complex) = 16 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-10 + + complex(c_double_complex), allocatable, target, dimension(:) :: hx, hresult + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + type(fftw_iodim64), target :: dims(1), howmany_dims(1) + integer :: b, j, k + double precision :: error, max_error + complex(c_double_complex) :: w, expected + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_guru64' (Fortran 2003) - " + + ! 1D batched C2C: HOWMANY batches of length N, contiguous (stride=1, dist=N). + ! Batch b (0-indexed): x[j] = exp(2*pi*i*(b+1)*j/N). + ! Expected forward DFT: output bin b+1 of batch b = N, all others zero. + allocate(hx(N*HOWMANY), hresult(N*HOWMANY)) + do b = 0, HOWMANY-1 + w = cmplx(0.0d0, 2.0d0 * pi * dble(b+1) / dble(N), kind=c_double_complex) + do j = 0, N-1 + hx(b*N + j + 1) = exp(w * dble(j)) + end do + end do + + call hipCheck(hipMalloc(dx, Nbytes)) + call hipCheck(hipMalloc(dy, Nbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes, hipMemcpyHostToDevice)) + + dims(1) = fftw_iodim64(int(N, c_intptr_t), 1_c_intptr_t, 1_c_intptr_t) ! n=N, is=1, os=1 + howmany_dims(1) = fftw_iodim64(int(HOWMANY, c_intptr_t), int(N, c_intptr_t), int(N, c_intptr_t)) + plan = fftw_plan_guru64_dft(1, dims, 1, howmany_dims, & + dx, dy, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, Nbytes, hipMemcpyDeviceToHost)) + + ! Verify: for batch b, output bin b+1 should equal N; all others zero. + max_error = 0.0d0 + do b = 0, HOWMANY-1 + do k = 0, N-1 + if (k == b+1) then + expected = cmplx(dble(N), 0.0d0, kind=c_double_complex) + else + expected = cmplx(0.0d0, 0.0d0, kind=c_double_complex) + end if + error = abs(hresult(b*N + k + 1) - expected) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + end do + + if (.not. (max_error <= tol * dble(N))) then + write(*,*) "FAILED! max error = ", max_error + call exit(1) + end if + + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult) + + write(*,*) "PASSED!" +end program hipfftw_guru64_test diff --git a/projects/hipfft/fortran/test/hipfftw_many.f03 b/projects/hipfft/fortran/test/hipfftw_many.f03 new file mode 100644 index 000000000000..9bc53cf5a5af --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_many.f03 @@ -0,0 +1,309 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! fftw_plan_many_dft{,_r2c,_c2r} on device memory. The C API takes dimensions +! in C order: for a Fortran z(NX, NY), pass n = [NY, NX] (likewise the embeds). +program hipfftw_many_test + use iso_c_binding + use hip + use hipfftw + implicit none + + double precision, parameter :: tol = 1.0d-12 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + integer :: nfail, seed_size + integer, allocatable :: seed(:) + + call random_seed(size=seed_size) + allocate(seed(seed_size)) + seed = 42 + call random_seed(put=seed) + deallocate(seed) + + nfail = 0 + write(*,'(a)') "=== hipfftw many GPU Tests ===" + + call test_1d_c2c_interleaved(nfail) + call test_2d_c2c_padded_embed(nfail) + call test_1d_c2r_roundtrip(nfail) + call test_many_vs_individual_c2c(nfail) + + write(*,*) + if (nfail > 0) then + write(*,'(i0,a)') nfail, " test(s) FAILED" + call exit(1) + else + write(*,*) "PASSED!" + end if + +contains + + subroutine report(max_err, tolerance, nfail) + double precision, intent(in) :: max_err, tolerance + integer, intent(inout) :: nfail + if (.not. (max_err <= tolerance)) then + write(*,'(a,es12.4,a)') "FAILED (max_err=", max_err, ")" + nfail = nfail + 1 + else + write(*,'(a,es12.4,a)') "PASSED (max_err=", max_err, ")" + end if + end subroutine + + ! 1D C2C, interleaved batches (istride = howmany, idist = 1). + ! x[j] = exp(2*pi*i*j/N) + 2*exp(2*pi*i*3*j/N): X[1] = N, X[3] = 2N, rest 0. + subroutine test_1d_c2c_interleaved(nfail) + integer, intent(inout) :: nfail + integer(c_int), parameter :: N = 8, howmany = 3 + integer(c_size_t), parameter :: total_bytes = N * howmany * 16 + complex(c_double_complex), allocatable, target :: hx(:), hresult(:) + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer(c_int), target :: n_arr(1), ie(1), oe(1) + integer :: j, b + double precision :: max_err, err + complex(c_double_complex) :: w, expected + + write(*,'(a)',advance="no") " 1D C2C interleaved batches: " + allocate(hx(N*howmany), hresult(N*howmany)) + hx = cmplx(0d0, 0d0, kind=c_double_complex) + + w = cmplx(0d0, 2d0*pi/dble(N), kind=c_double_complex) + do b = 0, howmany-1 + do j = 0, N-1 + hx(j*howmany + b + 1) = exp(w*dble(j)) + 2d0*exp(3d0*w*dble(j)) + end do + end do + + call hipCheck(hipMalloc(dx, total_bytes)) + call hipCheck(hipMalloc(dy, total_bytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), total_bytes, hipMemcpyHostToDevice)) + + n_arr = [N]; ie = [N]; oe = [N] + plan = fftw_plan_many_dft(1, c_loc(n_arr), howmany, & + dx, c_loc(ie), howmany, 1, dy, c_loc(oe), howmany, 1, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, total_bytes, hipMemcpyDeviceToHost)) + + max_err = 0d0 + do b = 0, howmany-1 + do j = 0, N-1 + if (j == 1) then + expected = cmplx(dble(N), 0d0, kind=c_double_complex) + else if (j == 3) then + expected = cmplx(2d0*dble(N), 0d0, kind=c_double_complex) + else + expected = cmplx(0d0, 0d0, kind=c_double_complex) + end if + err = abs(hresult(j*howmany + b + 1) - expected) + if (max_err == max_err .and. .not. (err <= max_err)) max_err = err ! keeps a NaN + end do + end do + + call report(max_err, tol, nfail) + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult) + end subroutine + + ! 2D C2C on z(1:NX, 1:NY, :) of z(LDX, NY, howmany): n = [NY, NX], + ! inembed = [NY, LDX]. A single mode: Z(kx=1, ky=2) = NX*NY, rest 0. + subroutine test_2d_c2c_padded_embed(nfail) + integer, intent(inout) :: nfail + integer(c_int), parameter :: NX = 4, NY = 6, LDX = 8, howmany = 2 + integer(c_size_t), parameter :: total_bytes = LDX * NY * howmany * 16 + complex(c_double_complex), allocatable, target :: hx(:), hresult(:) + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer(c_int), target :: n_arr(2), ie(2), oe(2) + integer :: ix, iy, kx, ky, b + double precision :: max_err, err + complex(c_double_complex) :: wx, wy, expected + + write(*,'(a)',advance="no") " 2D C2C padded embed: " + allocate(hx(LDX*NY*howmany), hresult(LDX*NY*howmany)) + hx = cmplx(0d0, 0d0, kind=c_double_complex) + + wx = cmplx(0d0, 2d0*pi/dble(NX), kind=c_double_complex) + wy = cmplx(0d0, 2d0*pi/dble(NY), kind=c_double_complex) + do b = 0, howmany-1 + do iy = 0, NY-1 + do ix = 0, NX-1 + hx(b*LDX*NY + iy*LDX + ix + 1) = exp(wx*dble(ix)) * exp(2d0*wy*dble(iy)) + end do + end do + end do + + call hipCheck(hipMalloc(dx, total_bytes)) + call hipCheck(hipMalloc(dy, total_bytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), total_bytes, hipMemcpyHostToDevice)) + + ! C order (reversed from Fortran): fastest dimension last. + n_arr = [NY, NX] + ie = [NY, LDX] + oe = [NY, LDX] + plan = fftw_plan_many_dft(2, c_loc(n_arr), howmany, & + dx, c_loc(ie), 1, LDX*NY, dy, c_loc(oe), 1, LDX*NY, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dy, total_bytes, hipMemcpyDeviceToHost)) + + max_err = 0d0 + do b = 0, howmany-1 + do ky = 0, NY-1 + do kx = 0, NX-1 + if (kx == 1 .and. ky == 2) then + expected = cmplx(dble(NX*NY), 0d0, kind=c_double_complex) + else + expected = cmplx(0d0, 0d0, kind=c_double_complex) + end if + err = abs(hresult(b*LDX*NY + ky*LDX + kx + 1) - expected) + if (max_err == max_err .and. .not. (err <= max_err)) max_err = err ! keeps a NaN + end do + end do + end do + + call report(max_err, tol, nfail) + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + deallocate(hx, hresult) + end subroutine + + ! 1D R2C then C2R round trip on random input: c2r(r2c(x)) = N * x. + subroutine test_1d_c2r_roundtrip(nfail) + integer, intent(inout) :: nfail + integer(c_int), parameter :: N = 16, Nc = N/2+1, howmany = 3 + integer(c_size_t), parameter :: rbytes = N * howmany * 8 + integer(c_size_t), parameter :: cbytes = Nc * howmany * 16 + real(c_double), allocatable, target :: hx(:), hresult(:) + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr, dz = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer(c_int), target :: n_arr(1), ie_r(1), oe_c(1), ie_c(1), oe_r(1) + integer :: j, b + double precision :: max_err, err + + write(*,'(a)',advance="no") " 1D R2C/C2R round-trip: " + allocate(hx(N*howmany), hresult(N*howmany)) + + call random_number(hx) + + call hipCheck(hipMalloc(dx, rbytes)) + call hipCheck(hipMalloc(dy, cbytes)) + call hipCheck(hipMalloc(dz, rbytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), rbytes, hipMemcpyHostToDevice)) + + n_arr = [N]; ie_r = [N]; oe_c = [Nc]; ie_c = [Nc]; oe_r = [N] + + plan = fftw_plan_many_dft_r2c(1, c_loc(n_arr), howmany, & + dx, c_loc(ie_r), 1, N, dy, c_loc(oe_c), 1, Nc, FFTW_ESTIMATE) + call fftw_execute_dft_r2c(plan, dx, dy) + call fftw_destroy_plan(plan) + + plan = fftw_plan_many_dft_c2r(1, c_loc(n_arr), howmany, & + dy, c_loc(ie_c), 1, Nc, dz, c_loc(oe_r), 1, N, FFTW_ESTIMATE) + call fftw_execute_dft_c2r(plan, dy, dz) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult(1)), dz, rbytes, hipMemcpyDeviceToHost)) + + max_err = 0d0 + do b = 0, howmany-1 + do j = 0, N-1 + err = abs(hresult(b*N + j + 1) - dble(N) * hx(b*N + j + 1)) + if (max_err == max_err .and. .not. (err <= max_err)) max_err = err ! keeps a NaN + end do + end do + + call report(max_err, tol, nfail) + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + call hipCheck(hipFree(dz)) + deallocate(hx, hresult) + end subroutine + + ! 1D C2C on random input: plan_many_dft against one dft_1d per batch. + subroutine test_many_vs_individual_c2c(nfail) + integer, intent(inout) :: nfail + integer(c_int), parameter :: N = 16, howmany = 5 + integer(c_size_t), parameter :: total_bytes = N * howmany * 16 + integer(c_size_t), parameter :: slice_bytes = N * 16 + complex(c_double_complex), allocatable, target :: hx(:), hout_many(:), hout_ind(:) + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr + type(c_ptr) :: d_sin = c_null_ptr, d_sout = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer(c_int), target :: n_arr(1), ie(1), oe(1) + integer :: j + double precision :: max_err, err + real(c_double) :: rr(N*howmany), ri(N*howmany) + integer :: b + + write(*,'(a)',advance="no") " 1D C2C many vs individual: " + allocate(hx(N*howmany), hout_many(N*howmany), hout_ind(N*howmany)) + + call random_number(rr) + call random_number(ri) + do j = 1, N*howmany + hx(j) = cmplx(rr(j), ri(j), kind=c_double_complex) + end do + + call hipCheck(hipMalloc(dx, total_bytes)) + call hipCheck(hipMalloc(dy, total_bytes)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), total_bytes, hipMemcpyHostToDevice)) + + n_arr = [N]; ie = [N]; oe = [N] + plan = fftw_plan_many_dft(1, c_loc(n_arr), howmany, & + dx, c_loc(ie), 1, N, dy, c_loc(oe), 1, N, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, dx, dy) + call fftw_destroy_plan(plan) + call hipCheck(hipMemcpy(c_loc(hout_many(1)), dy, total_bytes, hipMemcpyDeviceToHost)) + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + + call hipCheck(hipMalloc(d_sin, slice_bytes)) + call hipCheck(hipMalloc(d_sout, slice_bytes)) + + do b = 0, howmany-1 + call hipCheck(hipMemcpy(d_sin, c_loc(hx(b*N+1)), slice_bytes, hipMemcpyHostToDevice)) + plan = fftw_plan_dft_1d(N, d_sin, d_sout, FFTW_FORWARD, FFTW_ESTIMATE) + call fftw_execute_dft(plan, d_sin, d_sout) + call fftw_destroy_plan(plan) + call hipCheck(hipMemcpy(c_loc(hout_ind(b*N+1)), d_sout, slice_bytes, hipMemcpyDeviceToHost)) + end do + call hipCheck(hipFree(d_sin)) + call hipCheck(hipFree(d_sout)) + + max_err = 0d0 + do j = 1, N*howmany + err = abs(hout_many(j) - hout_ind(j)) + if (max_err == max_err .and. .not. (err <= max_err)) max_err = err ! keeps a NaN + end do + + call report(max_err, tol, nfail) + deallocate(hx, hout_many, hout_ind) + end subroutine + +end program hipfftw_many_test diff --git a/projects/hipfft/fortran/test/hipfftw_r2c_c2r.f03 b/projects/hipfft/fortran/test/hipfftw_r2c_c2r.f03 new file mode 100644 index 000000000000..7524fae128b0 --- /dev/null +++ b/projects/hipfft/fortran/test/hipfftw_r2c_c2r.f03 @@ -0,0 +1,113 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program hipfftw_r2c_c2r_test + use iso_c_binding + use hip + use hipfftw + + implicit none + + integer(c_int), parameter :: N = 16 + integer(c_int), parameter :: Nc = N / 2 + 1 + integer(c_size_t), parameter :: Nbytes_r = N * 8 ! sizeof(double) = 8 + integer(c_size_t), parameter :: Nbytes_c = Nc * 16 ! sizeof(double complex) = 16 + double precision, parameter :: pi = 4.0d0 * atan(1.0d0) + double precision, parameter :: tol = 1.0d-12 + + real(c_double), allocatable, target, dimension(:) :: hx, hresult_r + complex(c_double_complex), allocatable, target, dimension(:) :: hresult_c + type(c_ptr) :: dx = c_null_ptr, dy = c_null_ptr, dz = c_null_ptr + type(c_ptr) :: plan = c_null_ptr + integer :: j + double precision :: error, max_error + + write(*,"(a)",advance="no") "-- Running test 'hipfftw_r2c_c2r' (Fortran 2003) - " + + ! Real signal: x[j] = 1 + 2*cos(2*pi*j/N) + 3*cos(2*pi*3*j/N) + ! R2C output (Nc = N/2+1 complex values, 0-indexed): + ! X[0] = N, X[1] = N, X[3] = 3*N/2, rest zero + allocate(hx(N), hresult_c(Nc), hresult_r(N)) + do j = 0, N-1 + hx(j+1) = 1.0d0 + 2.0d0 * cos(2.0d0 * pi * j / dble(N)) & + + 3.0d0 * cos(6.0d0 * pi * j / dble(N)) + end do + + call hipCheck(hipMalloc(dx, Nbytes_r)) + call hipCheck(hipMalloc(dy, Nbytes_c)) + call hipCheck(hipMemcpy(dx, c_loc(hx(1)), Nbytes_r, hipMemcpyHostToDevice)) + + ! Forward R2C. Device pointers pass directly to the FFTW C API. + plan = fftw_plan_dft_r2c_1d(N, dx, dy, FFTW_ESTIMATE) + call fftw_execute_dft_r2c(plan, dx, dy) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult_c(1)), dy, Nbytes_c, hipMemcpyDeviceToHost)) + + max_error = 0.0d0 + do j = 0, Nc-1 + if (j == 0 .or. j == 1) then + error = abs(hresult_c(j+1) - cmplx(dble(N), 0.0d0, kind=c_double_complex)) + else if (j == 3) then + error = abs(hresult_c(j+1) - cmplx(1.5d0 * N, 0.0d0, kind=c_double_complex)) + else + error = abs(hresult_c(j+1)) + end if + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + if (.not. (max_error <= tol)) then + write(*,*) "FAILED! R2C: max error = ", max_error + call exit(1) + end if + + ! Backward C2R: c2r(r2c(x)) should equal N * x + call hipCheck(hipMemcpy(dy, c_loc(hresult_c(1)), Nbytes_c, hipMemcpyHostToDevice)) + call hipCheck(hipMalloc(dz, Nbytes_r)) + + plan = fftw_plan_dft_c2r_1d(N, dy, dz, FFTW_ESTIMATE) + call fftw_execute_dft_c2r(plan, dy, dz) + call fftw_destroy_plan(plan) + + call hipCheck(hipMemcpy(c_loc(hresult_r(1)), dz, Nbytes_r, hipMemcpyDeviceToHost)) + + max_error = 0.0d0 + do j = 1, N + error = abs(hresult_r(j) - dble(N) * hx(j)) + if (max_error == max_error .and. .not. (error <= max_error)) max_error = error ! keeps a NaN + end do + + if (.not. (max_error <= tol)) then + write(*,*) "FAILED! C2R round-trip: max error = ", max_error + call exit(1) + end if + + call hipCheck(hipFree(dx)) + call hipCheck(hipFree(dy)) + call hipCheck(hipFree(dz)) + deallocate(hx, hresult_c, hresult_r) + + write(*,*) "PASSED!" +end program hipfftw_r2c_c2r_test From c91c822790b45cc798a7efdc4590dc3040bae782 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Tue, 3 Nov 2026 14:49:49 -0600 Subject: [PATCH 03/12] refactor(hipfft): move the Fortran binding to bindings/fortran/hipfft The hipFFT Fortran binding consumes hipFFT's public API and builds standalone against an installed hipFFT, so it moves out of the library into bindings/fortran/hipfft, the tree every monorepo and TheRock use for the Fortran bindings (RFC0015). Nothing is wired into the library build any more: the library is back to its state on develop. - bindings/fortran/hipfft reads hipFFT's version from projects/hipfft - the binding has its own .gitattributes and CHANGELOG.md - CODEOWNERS: /bindings/fortran/hipfft/, same owners - repos-config.json: register bindings/fortran/hipfft so CI detects changes --- .github/CODEOWNERS | 2 +- .github/repos-config.json | 9 +++++++++ bindings/fortran/hipfft/.gitattributes | 3 +++ bindings/fortran/hipfft/CHANGELOG.md | 17 +++++++++++++++++ .../fortran/hipfft}/CMakeLists.txt | 4 ++-- .../hipfft}/cmake/toolchains/amdflang.cmake | 2 +- .../fortran/hipfft}/cmake/toolchains/cray.cmake | 2 +- .../fortran/hipfft}/cmake/toolchains/gnu.cmake | 2 +- .../cmake/toolchains/intel-classic.cmake | 2 +- .../hipfft}/cmake/toolchains/intel.cmake | 2 +- .../hipfft}/cmake/toolchains/nvhpc.cmake | 2 +- .../hipfft}/hipfft-fortran-config.cmake.in | 2 +- .../fortran/hipfft}/hipfft.F90 | 0 .../hipfft}/hipfftw-fortran-config.cmake.in | 2 +- .../fortran/hipfft}/hipfftw.F90 | 0 .../fortran/hipfft}/test/CMakeLists.txt | 2 ++ .../fortran/hipfft}/test/hipfft.f03 | 2 +- .../fortran/hipfft}/test/hipfft.f08 | 2 +- .../hipfft}/test/hipfft_c2c_1d_batched_z.f03 | 0 .../hipfft}/test/hipfft_c2c_1d_batched_z.f08 | 0 .../fortran/hipfft}/test/hipfft_c2c_1d_c.f03 | 0 .../fortran/hipfft}/test/hipfft_c2c_1d_c.f08 | 0 .../fortran/hipfft}/test/hipfft_c2c_1d_z.f03 | 0 .../fortran/hipfft}/test/hipfft_c2c_1d_z.f08 | 0 .../fortran/hipfft}/test/hipfft_c2c_2d_z.f03 | 0 .../fortran/hipfft}/test/hipfft_c2c_2d_z.f08 | 0 .../fortran/hipfft}/test/hipfft_c2c_3d_z.f03 | 0 .../fortran/hipfft}/test/hipfft_c2c_3d_z.f08 | 0 .../hipfft}/test/hipfft_estimate_getsize_d.f03 | 0 .../hipfft}/test/hipfft_estimate_getsize_d.f08 | 0 .../hipfft}/test/hipfft_makeplanmany_z.f03 | 0 .../hipfft}/test/hipfft_makeplanmany_z.f08 | 0 .../hipfft}/test/hipfft_planmany_2d_z2z.f03 | 0 .../hipfft}/test/hipfft_planmany_2d_z2z.f08 | 0 .../hipfft}/test/hipfft_r2c_c2r_1d_d.f03 | 0 .../hipfft}/test/hipfft_r2c_c2r_1d_d.f08 | 0 .../hipfft}/test/hipfft_r2c_c2r_1d_s.f03 | 0 .../hipfft}/test/hipfft_r2c_c2r_1d_s.f08 | 0 .../fortran/hipfft}/test/hipfft_setstream_z.f03 | 0 .../fortran/hipfft}/test/hipfft_setstream_z.f08 | 0 .../fortran/hipfft}/test/hipfft_version.f03 | 0 .../fortran/hipfft}/test/hipfft_version.f08 | 0 .../hipfft}/test/hipfft_xt_descriptor_z.f03 | 0 .../hipfft}/test/hipfft_xt_makeplanmany_c.f03 | 0 .../fortran/hipfft}/test/hipfftw_alloc.f03 | 0 .../fortran/hipfft}/test/hipfftw_c2c.f03 | 0 .../fortran/hipfft}/test/hipfftw_dft_2d.f03 | 0 .../fortran/hipfft}/test/hipfftw_dft_3d.f03 | 0 .../fortran/hipfft}/test/hipfftw_guru.f03 | 0 .../fortran/hipfft}/test/hipfftw_guru64.f03 | 0 .../fortran/hipfft}/test/hipfftw_many.f03 | 0 .../fortran/hipfft}/test/hipfftw_r2c_c2r.f03 | 0 projects/hipfft/.gitattributes | 3 --- projects/hipfft/CHANGELOG.md | 14 -------------- projects/hipfft/CMakeLists.txt | 16 +--------------- .../building-installing-hipfft-and-hipfftw.rst | 6 ------ 56 files changed, 45 insertions(+), 51 deletions(-) create mode 100644 bindings/fortran/hipfft/.gitattributes create mode 100644 bindings/fortran/hipfft/CHANGELOG.md rename {projects/hipfft/fortran => bindings/fortran/hipfft}/CMakeLists.txt (99%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/cmake/toolchains/amdflang.cmake (97%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/cmake/toolchains/cray.cmake (97%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/cmake/toolchains/gnu.cmake (97%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/cmake/toolchains/intel-classic.cmake (97%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/cmake/toolchains/intel.cmake (97%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/cmake/toolchains/nvhpc.cmake (97%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/hipfft-fortran-config.cmake.in (98%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/hipfft.F90 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/hipfftw-fortran-config.cmake.in (99%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/hipfftw.F90 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/CMakeLists.txt (98%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft.f03 (99%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft.f08 (99%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_1d_batched_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_1d_batched_z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_1d_c.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_1d_c.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_1d_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_1d_z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_2d_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_2d_z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_3d_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_c2c_3d_z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_estimate_getsize_d.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_estimate_getsize_d.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_makeplanmany_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_makeplanmany_z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_planmany_2d_z2z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_planmany_2d_z2z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_r2c_c2r_1d_d.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_r2c_c2r_1d_d.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_r2c_c2r_1d_s.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_r2c_c2r_1d_s.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_setstream_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_setstream_z.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_version.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_version.f08 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_xt_descriptor_z.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfft_xt_makeplanmany_c.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_alloc.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_c2c.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_dft_2d.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_dft_3d.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_guru.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_guru64.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_many.f03 (100%) rename {projects/hipfft/fortran => bindings/fortran/hipfft}/test/hipfftw_r2c_c2r.f03 (100%) delete mode 100644 projects/hipfft/.gitattributes diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 5f9f96c50afa..a27cb75849b1 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -199,7 +199,7 @@ /projects/hipfft/**/.readthedocs.yaml @ROCm/fft-reviewers @ROCm/fft-docs-reviewers /projects/hipfft/docs/ @ROCm/fft-reviewers @ROCm/fft-docs-reviewers /projects/hipfft/library/include/ @ROCm/fft-reviewers @ROCm/fft-docs-reviewers -/projects/hipfft/fortran/ @ROCm/rocm-fortran-maintainers @ROCm/fft-reviewers +/bindings/fortran/hipfft/ @ROCm/rocm-fortran-maintainers @ROCm/fft-reviewers /projects/hiprand/**/*.md @ROCm/prims-rands-reviewers @ROCm/rands-docs-reviewers /projects/hiprand/**/*.rst @ROCm/prims-rands-reviewers @ROCm/rands-docs-reviewers diff --git a/.github/repos-config.json b/.github/repos-config.json index 218164737f74..9f1c87859d11 100644 --- a/.github/repos-config.json +++ b/.github/repos-config.json @@ -305,6 +305,15 @@ "auto_subtree_pull": false, "auto_subtree_push": false, "monorepo_source_of_truth": true + }, + { + "name": "hipfft", + "url": "ROCm/rocm-libraries", + "branch": "develop", + "category": "bindings/fortran", + "auto_subtree_pull": false, + "auto_subtree_push": false, + "monorepo_source_of_truth": true } ] } diff --git a/bindings/fortran/hipfft/.gitattributes b/bindings/fortran/hipfft/.gitattributes new file mode 100644 index 000000000000..54c974d9df6f --- /dev/null +++ b/bindings/fortran/hipfft/.gitattributes @@ -0,0 +1,3 @@ +# Generated by the rocm-fortran generator +/hipfft.F90 linguist-generated=true +/hipfftw.F90 linguist-generated=true diff --git a/bindings/fortran/hipfft/CHANGELOG.md b/bindings/fortran/hipfft/CHANGELOG.md new file mode 100644 index 000000000000..71eb1229d293 --- /dev/null +++ b/bindings/fortran/hipfft/CHANGELOG.md @@ -0,0 +1,17 @@ +# Changelog for the hipFFT Fortran binding + +## Unreleased + +### Added + +* Generated Fortran bindings, as two independent modules: `use hipfft` and link + `hip::hipfft_fortran` for the hipFFT API, or `use hipfftw` and link `hip::hipfftw_fortran` for the + FFTW compatibility API. + Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows and on the CUDA + backend), `BUILD_FORTRAN_CLIENTS` and `FORTRAN_ARRAY_INTERFACES` (`assumed-shape` by + default; `none` or `assumed-rank`); the `HIPFFT_*` and `HIPFFTW_*` spellings of the first two + switch either half on its own. Found with `find_package(hipfft-fortran)` and + `find_package(hipfftw-fortran)`; the archives and the `.mod` files install per compiler, + under `/fortran/` and `/fortran/`. + The archive has one section per procedure: link with `-Wl,--gc-sections` to keep only the wrappers + you call. diff --git a/projects/hipfft/fortran/CMakeLists.txt b/bindings/fortran/hipfft/CMakeLists.txt similarity index 99% rename from projects/hipfft/fortran/CMakeLists.txt rename to bindings/fortran/hipfft/CMakeLists.txt index 2c7dba608448..dc6eb77414d1 100644 --- a/projects/hipfft/fortran/CMakeLists.txt +++ b/bindings/fortran/hipfft/CMakeLists.txt @@ -338,8 +338,8 @@ include(CMakePackageConfigHelpers) # From this tree's root, not hipfft_VERSION, which standalone is the INSTALLED # hipFFT. One version for both packages. set(_fortran_version "") -if(EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../CMakeLists.txt") - file(READ "${CMAKE_CURRENT_SOURCE_DIR}/../CMakeLists.txt" _hipfft_root) +if(EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../../../projects/hipfft/CMakeLists.txt") + file(READ "${CMAKE_CURRENT_SOURCE_DIR}/../../../projects/hipfft/CMakeLists.txt" _hipfft_root) set(_v_parts "") foreach(_v_comp MAJOR MINOR PATCH) # Judged on the whole match: a failed match leaves CMAKE_MATCH_1 stale. diff --git a/projects/hipfft/fortran/cmake/toolchains/amdflang.cmake b/bindings/fortran/hipfft/cmake/toolchains/amdflang.cmake similarity index 97% rename from projects/hipfft/fortran/cmake/toolchains/amdflang.cmake rename to bindings/fortran/hipfft/cmake/toolchains/amdflang.cmake index 8ebfda911904..bf4a0e7fe0e8 100644 --- a/projects/hipfft/fortran/cmake/toolchains/amdflang.cmake +++ b/bindings/fortran/hipfft/cmake/toolchains/amdflang.cmake @@ -23,7 +23,7 @@ # ############################################################################ # AMD ROCm toolchain (amdflang). -# Usage, from projects/hipfft/fortran: +# Usage, from bindings/fortran/hipfft: # cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/amdflang.cmake set(CMAKE_Fortran_COMPILER amdflang CACHE FILEPATH "Fortran compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/cray.cmake b/bindings/fortran/hipfft/cmake/toolchains/cray.cmake similarity index 97% rename from projects/hipfft/fortran/cmake/toolchains/cray.cmake rename to bindings/fortran/hipfft/cmake/toolchains/cray.cmake index bcf5ed05a895..fe1e6e7a2536 100644 --- a/projects/hipfft/fortran/cmake/toolchains/cray.cmake +++ b/bindings/fortran/hipfft/cmake/toolchains/cray.cmake @@ -23,7 +23,7 @@ # ############################################################################ # Cray toolchain (ftn and cc wrappers; the loaded PrgEnv module picks the compiler). -# Usage, from projects/hipfft/fortran: +# Usage, from bindings/fortran/hipfft: # cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/cray.cmake set(CMAKE_Fortran_COMPILER ftn CACHE FILEPATH "Fortran compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/gnu.cmake b/bindings/fortran/hipfft/cmake/toolchains/gnu.cmake similarity index 97% rename from projects/hipfft/fortran/cmake/toolchains/gnu.cmake rename to bindings/fortran/hipfft/cmake/toolchains/gnu.cmake index 59295eae01f7..749b8b3d03e3 100644 --- a/projects/hipfft/fortran/cmake/toolchains/gnu.cmake +++ b/bindings/fortran/hipfft/cmake/toolchains/gnu.cmake @@ -23,7 +23,7 @@ # ############################################################################ # GNU toolchain (gfortran). -# Usage, from projects/hipfft/fortran: +# Usage, from bindings/fortran/hipfft: # cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/gnu.cmake set(CMAKE_Fortran_COMPILER gfortran CACHE FILEPATH "Fortran compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake b/bindings/fortran/hipfft/cmake/toolchains/intel-classic.cmake similarity index 97% rename from projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake rename to bindings/fortran/hipfft/cmake/toolchains/intel-classic.cmake index 4382210ea4ba..4b753cc10912 100644 --- a/projects/hipfft/fortran/cmake/toolchains/intel-classic.cmake +++ b/bindings/fortran/hipfft/cmake/toolchains/intel-classic.cmake @@ -23,7 +23,7 @@ # ############################################################################ # Classic Intel toolchain (ifort, deprecated by Intel in favour of ifx). -# Usage, from projects/hipfft/fortran: +# Usage, from bindings/fortran/hipfft: # cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/intel-classic.cmake set(CMAKE_Fortran_COMPILER ifort CACHE FILEPATH "Fortran compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/intel.cmake b/bindings/fortran/hipfft/cmake/toolchains/intel.cmake similarity index 97% rename from projects/hipfft/fortran/cmake/toolchains/intel.cmake rename to bindings/fortran/hipfft/cmake/toolchains/intel.cmake index d50ca3a65cee..633a39368b85 100644 --- a/projects/hipfft/fortran/cmake/toolchains/intel.cmake +++ b/bindings/fortran/hipfft/cmake/toolchains/intel.cmake @@ -23,7 +23,7 @@ # ############################################################################ # Intel oneAPI toolchain (ifx, the LLVM-based compiler). -# Usage, from projects/hipfft/fortran: +# Usage, from bindings/fortran/hipfft: # cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/intel.cmake set(CMAKE_Fortran_COMPILER ifx CACHE FILEPATH "Fortran compiler") diff --git a/projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake b/bindings/fortran/hipfft/cmake/toolchains/nvhpc.cmake similarity index 97% rename from projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake rename to bindings/fortran/hipfft/cmake/toolchains/nvhpc.cmake index 36ca6638f8f8..b53452f225db 100644 --- a/projects/hipfft/fortran/cmake/toolchains/nvhpc.cmake +++ b/bindings/fortran/hipfft/cmake/toolchains/nvhpc.cmake @@ -23,7 +23,7 @@ # ############################################################################ # NVIDIA HPC SDK toolchain (nvfortran). -# Usage, from projects/hipfft/fortran: +# Usage, from bindings/fortran/hipfft: # cmake -S . -B build -DCMAKE_TOOLCHAIN_FILE=cmake/toolchains/nvhpc.cmake set(CMAKE_Fortran_COMPILER nvfortran CACHE FILEPATH "Fortran compiler") diff --git a/projects/hipfft/fortran/hipfft-fortran-config.cmake.in b/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in similarity index 98% rename from projects/hipfft/fortran/hipfft-fortran-config.cmake.in rename to bindings/fortran/hipfft/hipfft-fortran-config.cmake.in index 50ffd829eb5d..83bec1cb69ae 100644 --- a/projects/hipfft/fortran/hipfft-fortran-config.cmake.in +++ b/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in @@ -85,7 +85,7 @@ if(DEFINED HIPFFT_FORTRAN_COMPILER_DIR) endif() set(_hipfft_dir "${HIPFFT_FORTRAN_COMPILER_DIR}") else() - # Must mirror the mapping in projects/hipfft/fortran/CMakeLists.txt. + # Must mirror the mapping in bindings/fortran/hipfft/CMakeLists.txt. if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") set(_hipfft_fc "gfortran") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Flang") diff --git a/projects/hipfft/fortran/hipfft.F90 b/bindings/fortran/hipfft/hipfft.F90 similarity index 100% rename from projects/hipfft/fortran/hipfft.F90 rename to bindings/fortran/hipfft/hipfft.F90 diff --git a/projects/hipfft/fortran/hipfftw-fortran-config.cmake.in b/bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in similarity index 99% rename from projects/hipfft/fortran/hipfftw-fortran-config.cmake.in rename to bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in index 3974128bf4ef..6655b29d05dc 100644 --- a/projects/hipfft/fortran/hipfftw-fortran-config.cmake.in +++ b/bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in @@ -85,7 +85,7 @@ if(DEFINED HIPFFTW_FORTRAN_COMPILER_DIR) endif() set(_hipfftw_dir "${HIPFFTW_FORTRAN_COMPILER_DIR}") else() - # Must mirror the mapping in projects/hipfft/fortran/CMakeLists.txt. + # Must mirror the mapping in bindings/fortran/hipfft/CMakeLists.txt. if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") set(_hipfftw_fc "gfortran") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Flang") diff --git a/projects/hipfft/fortran/hipfftw.F90 b/bindings/fortran/hipfft/hipfftw.F90 similarity index 100% rename from projects/hipfft/fortran/hipfftw.F90 rename to bindings/fortran/hipfft/hipfftw.F90 diff --git a/projects/hipfft/fortran/test/CMakeLists.txt b/bindings/fortran/hipfft/test/CMakeLists.txt similarity index 98% rename from projects/hipfft/fortran/test/CMakeLists.txt rename to bindings/fortran/hipfft/test/CMakeLists.txt index 430667c2a500..85a2094db649 100644 --- a/projects/hipfft/fortran/test/CMakeLists.txt +++ b/bindings/fortran/hipfft/test/CMakeLists.txt @@ -144,6 +144,8 @@ elseif(NOT TARGET hip::hipfftw) "tests (they link libhipfftw). Point CMAKE_PREFIX_PATH at an installed " "ROCm to build them standalone.") else() + # hipfftw_fortran_add_test(): builds .f03 as test + # hipfftw_fortran_. function(hipfftw_fortran_add_test name) set(src "${CMAKE_CURRENT_SOURCE_DIR}/${name}.f03") if(NOT EXISTS "${src}") diff --git a/projects/hipfft/fortran/test/hipfft.f03 b/bindings/fortran/hipfft/test/hipfft.f03 similarity index 99% rename from projects/hipfft/fortran/test/hipfft.f03 rename to bindings/fortran/hipfft/test/hipfft.f03 index aba6b8b9b027..5b31f1b1f09c 100644 --- a/projects/hipfft/fortran/test/hipfft.f03 +++ b/bindings/fortran/hipfft/test/hipfft.f03 @@ -101,4 +101,4 @@ program hipfft_example write(*,*) "PASSED!" -end program hipfft_example \ No newline at end of file +end program hipfft_example diff --git a/projects/hipfft/fortran/test/hipfft.f08 b/bindings/fortran/hipfft/test/hipfft.f08 similarity index 99% rename from projects/hipfft/fortran/test/hipfft.f08 rename to bindings/fortran/hipfft/test/hipfft.f08 index eb641ad574f1..ef680b01df0f 100644 --- a/projects/hipfft/fortran/test/hipfft.f08 +++ b/bindings/fortran/hipfft/test/hipfft.f08 @@ -66,7 +66,7 @@ program hipfft_example call hipfftCheck(hipfftPlan1d(plan, N, HIPFFT_Z2Z, 1)) call hipfftCheck(hipfftExecZ2Z(plan, dx, dx, direction)) - + call hipCheck(hipDeviceSynchronize()) call hipCheck(hipMemcpy(hx,dx,hipMemcpyDeviceToHost)) diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f03 b/bindings/fortran/hipfft/test/hipfft_c2c_1d_batched_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f03 rename to bindings/fortran/hipfft/test/hipfft_c2c_1d_batched_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f08 b/bindings/fortran/hipfft/test/hipfft_c2c_1d_batched_z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_1d_batched_z.f08 rename to bindings/fortran/hipfft/test/hipfft_c2c_1d_batched_z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f03 b/bindings/fortran/hipfft/test/hipfft_c2c_1d_c.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_1d_c.f03 rename to bindings/fortran/hipfft/test/hipfft_c2c_1d_c.f03 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_c.f08 b/bindings/fortran/hipfft/test/hipfft_c2c_1d_c.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_1d_c.f08 rename to bindings/fortran/hipfft/test/hipfft_c2c_1d_c.f08 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f03 b/bindings/fortran/hipfft/test/hipfft_c2c_1d_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_1d_z.f03 rename to bindings/fortran/hipfft/test/hipfft_c2c_1d_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_1d_z.f08 b/bindings/fortran/hipfft/test/hipfft_c2c_1d_z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_1d_z.f08 rename to bindings/fortran/hipfft/test/hipfft_c2c_1d_z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f03 b/bindings/fortran/hipfft/test/hipfft_c2c_2d_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_2d_z.f03 rename to bindings/fortran/hipfft/test/hipfft_c2c_2d_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_2d_z.f08 b/bindings/fortran/hipfft/test/hipfft_c2c_2d_z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_2d_z.f08 rename to bindings/fortran/hipfft/test/hipfft_c2c_2d_z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f03 b/bindings/fortran/hipfft/test/hipfft_c2c_3d_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_3d_z.f03 rename to bindings/fortran/hipfft/test/hipfft_c2c_3d_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_c2c_3d_z.f08 b/bindings/fortran/hipfft/test/hipfft_c2c_3d_z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_c2c_3d_z.f08 rename to bindings/fortran/hipfft/test/hipfft_c2c_3d_z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f03 b/bindings/fortran/hipfft/test/hipfft_estimate_getsize_d.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f03 rename to bindings/fortran/hipfft/test/hipfft_estimate_getsize_d.f03 diff --git a/projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f08 b/bindings/fortran/hipfft/test/hipfft_estimate_getsize_d.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_estimate_getsize_d.f08 rename to bindings/fortran/hipfft/test/hipfft_estimate_getsize_d.f08 diff --git a/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f03 b/bindings/fortran/hipfft/test/hipfft_makeplanmany_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_makeplanmany_z.f03 rename to bindings/fortran/hipfft/test/hipfft_makeplanmany_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_makeplanmany_z.f08 b/bindings/fortran/hipfft/test/hipfft_makeplanmany_z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_makeplanmany_z.f08 rename to bindings/fortran/hipfft/test/hipfft_makeplanmany_z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f03 b/bindings/fortran/hipfft/test/hipfft_planmany_2d_z2z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f03 rename to bindings/fortran/hipfft/test/hipfft_planmany_2d_z2z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f08 b/bindings/fortran/hipfft/test/hipfft_planmany_2d_z2z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_planmany_2d_z2z.f08 rename to bindings/fortran/hipfft/test/hipfft_planmany_2d_z2z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f03 b/bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_d.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f03 rename to bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_d.f03 diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f08 b/bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_d.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_d.f08 rename to bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_d.f08 diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f03 b/bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_s.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f03 rename to bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_s.f03 diff --git a/projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f08 b/bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_s.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_r2c_c2r_1d_s.f08 rename to bindings/fortran/hipfft/test/hipfft_r2c_c2r_1d_s.f08 diff --git a/projects/hipfft/fortran/test/hipfft_setstream_z.f03 b/bindings/fortran/hipfft/test/hipfft_setstream_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_setstream_z.f03 rename to bindings/fortran/hipfft/test/hipfft_setstream_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_setstream_z.f08 b/bindings/fortran/hipfft/test/hipfft_setstream_z.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_setstream_z.f08 rename to bindings/fortran/hipfft/test/hipfft_setstream_z.f08 diff --git a/projects/hipfft/fortran/test/hipfft_version.f03 b/bindings/fortran/hipfft/test/hipfft_version.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_version.f03 rename to bindings/fortran/hipfft/test/hipfft_version.f03 diff --git a/projects/hipfft/fortran/test/hipfft_version.f08 b/bindings/fortran/hipfft/test/hipfft_version.f08 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_version.f08 rename to bindings/fortran/hipfft/test/hipfft_version.f08 diff --git a/projects/hipfft/fortran/test/hipfft_xt_descriptor_z.f03 b/bindings/fortran/hipfft/test/hipfft_xt_descriptor_z.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_xt_descriptor_z.f03 rename to bindings/fortran/hipfft/test/hipfft_xt_descriptor_z.f03 diff --git a/projects/hipfft/fortran/test/hipfft_xt_makeplanmany_c.f03 b/bindings/fortran/hipfft/test/hipfft_xt_makeplanmany_c.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfft_xt_makeplanmany_c.f03 rename to bindings/fortran/hipfft/test/hipfft_xt_makeplanmany_c.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_alloc.f03 b/bindings/fortran/hipfft/test/hipfftw_alloc.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_alloc.f03 rename to bindings/fortran/hipfft/test/hipfftw_alloc.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_c2c.f03 b/bindings/fortran/hipfft/test/hipfftw_c2c.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_c2c.f03 rename to bindings/fortran/hipfft/test/hipfftw_c2c.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_dft_2d.f03 b/bindings/fortran/hipfft/test/hipfftw_dft_2d.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_dft_2d.f03 rename to bindings/fortran/hipfft/test/hipfftw_dft_2d.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_dft_3d.f03 b/bindings/fortran/hipfft/test/hipfftw_dft_3d.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_dft_3d.f03 rename to bindings/fortran/hipfft/test/hipfftw_dft_3d.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_guru.f03 b/bindings/fortran/hipfft/test/hipfftw_guru.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_guru.f03 rename to bindings/fortran/hipfft/test/hipfftw_guru.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_guru64.f03 b/bindings/fortran/hipfft/test/hipfftw_guru64.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_guru64.f03 rename to bindings/fortran/hipfft/test/hipfftw_guru64.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_many.f03 b/bindings/fortran/hipfft/test/hipfftw_many.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_many.f03 rename to bindings/fortran/hipfft/test/hipfftw_many.f03 diff --git a/projects/hipfft/fortran/test/hipfftw_r2c_c2r.f03 b/bindings/fortran/hipfft/test/hipfftw_r2c_c2r.f03 similarity index 100% rename from projects/hipfft/fortran/test/hipfftw_r2c_c2r.f03 rename to bindings/fortran/hipfft/test/hipfftw_r2c_c2r.f03 diff --git a/projects/hipfft/.gitattributes b/projects/hipfft/.gitattributes deleted file mode 100644 index bc7b43f0e898..000000000000 --- a/projects/hipfft/.gitattributes +++ /dev/null @@ -1,3 +0,0 @@ -# Generated by the rocm-fortran generator -/fortran/hipfft.F90 linguist-generated=true -/fortran/hipfftw.F90 linguist-generated=true diff --git a/projects/hipfft/CHANGELOG.md b/projects/hipfft/CHANGELOG.md index bba604b388fc..9893362a248f 100644 --- a/projects/hipfft/CHANGELOG.md +++ b/projects/hipfft/CHANGELOG.md @@ -5,20 +5,6 @@ Documentation for hipFFT is available at ## (Unreleased) hipFFT 1.0.27 -### Added - -* Generated Fortran bindings, as two independent modules: `use hipfft` and link - `hip::hipfft_fortran` for the hipFFT API, or `use hipfftw` and link `hip::hipfftw_fortran` for the - FFTW compatibility API. - Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows and on the CUDA - backend), `BUILD_FORTRAN_CLIENTS` and `FORTRAN_ARRAY_INTERFACES` (`assumed-shape` by - default; `none` or `assumed-rank`); the `HIPFFT_*` and `HIPFFTW_*` spellings of the first two - switch either half on its own. Found with `find_package(hipfft-fortran)` and - `find_package(hipfftw-fortran)`; the archives and the `.mod` files install per compiler, - under `/fortran/` and `/fortran/`. - The archive has one section per procedure: link with `-Wl,--gc-sections` to keep only the wrappers - you call. - ### Changed * Minor internal changes. diff --git a/projects/hipfft/CMakeLists.txt b/projects/hipfft/CMakeLists.txt index ca0b7167b1e7..46dd44d2e4ae 100644 --- a/projects/hipfft/CMakeLists.txt +++ b/projects/hipfft/CMakeLists.txt @@ -99,8 +99,7 @@ set(DEFAULT_GPUS ) if(BUILD_ADDRESS_SANITIZER) - # Kept off Fortran; fortran/ skips its tests under ASan, so links no Fortran. - add_compile_options($<$:-fsanitize=address>) + add_compile_options(-fsanitize=address) add_link_options(-fsanitize=address) add_link_options(-shared-libasan) SET(DEFAULT_GPUS @@ -210,19 +209,6 @@ endif() add_subdirectory( library ) -# fortran/ registers its tests under any client switch (BUILD_CLIENTS is -# expanded only below), but enable_testing() below needs BUILD_CLIENTS_TESTS. -if( BUILD_CLIENTS - OR BUILD_CLIENTS_SAMPLES - OR BUILD_CLIENTS_TESTS - OR BUILD_CLIENTS_BENCH ) - enable_testing() -endif() - -# Fortran bindings; self-guarding, reports HIP{FFT,FFTW}_HAVE_FORTRAN_BINDINGS. -# After library/, or its find_package( hipfft ) fallback finds an INSTALLED hipFFT. -add_subdirectory( fortran ) - # Build clients of the library if( BUILD_CLIENTS ) set( BUILD_CLIENTS_BENCH ON ) diff --git a/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst b/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst index 55f11d06d4a2..45c49e3d66d3 100644 --- a/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst +++ b/projects/hipfft/docs/install/building-installing-hipfft-and-hipfftw.rst @@ -63,9 +63,3 @@ To build hipFFT and hipFFTW from source, follow these steps: .. note:: The ``-DBUILD_CLIENTS=ON`` option is only allowed with the amdclang++ or HIPCC compilers. - - The following CMake options control the Fortran bindings: - - * ``-DBUILD_FORTRAN_BINDINGS``: Builds the Fortran bindings. Defaults to ``ON`` on Linux, ``OFF`` on Windows and with the CUDA backend. - * ``-DBUILD_FORTRAN_CLIENTS``: Builds the Fortran binding tests when the clients are built. Defaults to ``ON``. - * ``-DFORTRAN_ARRAY_INTERFACES``: Selects the array interfaces. ``assumed-shape`` by default; ``none`` or ``assumed-rank``. From b3f0f59a281fc71a959b937eb1229c5aa409fbd7 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Tue, 3 Nov 2026 16:47:46 -0600 Subject: [PATCH 04/12] chore(hipfft): regenerate the Fortran binding and add its metadata Regenerate bindings/fortran/hipfft with rocm-fortran-generator 9c8b3e4, and commit its metadata in bindings/fortran/hipfft/metadata/, where the generator reads it from a checkout, instead of the copy kept in the generator. --- bindings/fortran/hipfft/hipfft.F90 | 340 ++- bindings/fortran/hipfft/hipfftw.F90 | 2137 ++++++++++++++++- bindings/fortran/hipfft/metadata/hipfft.toml | 101 + bindings/fortran/hipfft/metadata/hipfftw.toml | 61 + 4 files changed, 2443 insertions(+), 196 deletions(-) create mode 100644 bindings/fortran/hipfft/metadata/hipfft.toml create mode 100644 bindings/fortran/hipfft/metadata/hipfftw.toml diff --git a/bindings/fortran/hipfft/hipfft.F90 b/bindings/fortran/hipfft/hipfft.F90 index 96adc8d7d926..0fa8a09ec2e0 100644 --- a/bindings/fortran/hipfft/hipfft.F90 +++ b/bindings/fortran/hipfft/hipfft.F90 @@ -135,7 +135,6 @@ module hipfft interface hipfftPlan1d function hipfftPlan1d_(plan,nx,myType,batch) bind(c, name="hipfftPlan1d") - use iso_c_binding import implicit none integer(c_int) :: hipfftPlan1d_ @@ -148,7 +147,6 @@ function hipfftPlan1d_(plan,nx,myType,batch) bind(c, name="hipfftPlan1d") interface hipfftPlan2d function hipfftPlan2d_(plan,nx,ny,myType) bind(c, name="hipfftPlan2d") - use iso_c_binding import implicit none integer(c_int) :: hipfftPlan2d_ @@ -161,7 +159,6 @@ function hipfftPlan2d_(plan,nx,ny,myType) bind(c, name="hipfftPlan2d") interface hipfftPlan3d function hipfftPlan3d_(plan,nx,ny,nz,myType) bind(c, name="hipfftPlan3d") - use iso_c_binding import implicit none integer(c_int) :: hipfftPlan3d_ @@ -176,7 +173,6 @@ function hipfftPlan3d_(plan,nx,ny,nz,myType) bind(c, name="hipfftPlan3d") interface hipfftPlanMany function hipfftPlanMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType,batch) & bind(c, name="hipfftPlanMany") - use iso_c_binding import implicit none integer(c_int) :: hipfftPlanMany_ @@ -206,7 +202,6 @@ function hipfftPlanMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist interface hipfftCreate function hipfftCreate_(plan) bind(c, name="hipfftCreate") - use iso_c_binding import implicit none integer(c_int) :: hipfftCreate_ @@ -216,7 +211,6 @@ function hipfftCreate_(plan) bind(c, name="hipfftCreate") interface hipfftExtPlanScaleFactor function hipfftExtPlanScaleFactor_(plan,scalefactor) bind(c, name="hipfftExtPlanScaleFactor") - use iso_c_binding import implicit none integer(c_int) :: hipfftExtPlanScaleFactor_ @@ -227,7 +221,6 @@ function hipfftExtPlanScaleFactor_(plan,scalefactor) bind(c, name="hipfftExtPlan interface hipfftMakePlan1d function hipfftMakePlan1d_(plan,nx,myType,batch,workSize) bind(c, name="hipfftMakePlan1d") - use iso_c_binding import implicit none integer(c_int) :: hipfftMakePlan1d_ @@ -243,7 +236,6 @@ function hipfftMakePlan1d_(plan,nx,myType,batch,workSize) bind(c, name="hipfftMa interface hipfftMakePlan2d function hipfftMakePlan2d_(plan,nx,ny,myType,workSize) bind(c, name="hipfftMakePlan2d") - use iso_c_binding import implicit none integer(c_int) :: hipfftMakePlan2d_ @@ -259,7 +251,6 @@ function hipfftMakePlan2d_(plan,nx,ny,myType,workSize) bind(c, name="hipfftMakeP interface hipfftMakePlan3d function hipfftMakePlan3d_(plan,nx,ny,nz,myType,workSize) bind(c, name="hipfftMakePlan3d") - use iso_c_binding import implicit none integer(c_int) :: hipfftMakePlan3d_ @@ -278,7 +269,6 @@ function hipfftMakePlan3d_(plan,nx,ny,nz,myType,workSize) bind(c, name="hipfftMa function hipfftMakePlanMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) & bind(c, name="hipfftMakePlanMany") - use iso_c_binding import implicit none integer(c_int) :: hipfftMakePlanMany_ @@ -313,7 +303,6 @@ function hipfftMakePlanMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,o function hipfftMakePlanMany64_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) & bind(c, name="hipfftMakePlanMany64") - use iso_c_binding import implicit none integer(c_int) :: hipfftMakePlanMany64_ @@ -346,7 +335,6 @@ function hipfftMakePlanMany64_(plan,rank,n,inembed,istride,idist,onembed,ostride interface hipfftEstimate1d function hipfftEstimate1d_(nx,myType,batch,workSize) bind(c, name="hipfftEstimate1d") - use iso_c_binding import implicit none integer(c_int) :: hipfftEstimate1d_ @@ -361,7 +349,6 @@ function hipfftEstimate1d_(nx,myType,batch,workSize) bind(c, name="hipfftEstimat interface hipfftEstimate2d function hipfftEstimate2d_(nx,ny,myType,workSize) bind(c, name="hipfftEstimate2d") - use iso_c_binding import implicit none integer(c_int) :: hipfftEstimate2d_ @@ -376,7 +363,6 @@ function hipfftEstimate2d_(nx,ny,myType,workSize) bind(c, name="hipfftEstimate2d interface hipfftEstimate3d function hipfftEstimate3d_(nx,ny,nz,myType,workSize) bind(c, name="hipfftEstimate3d") - use iso_c_binding import implicit none integer(c_int) :: hipfftEstimate3d_ @@ -394,7 +380,6 @@ function hipfftEstimate3d_(nx,ny,nz,myType,workSize) bind(c, name="hipfftEstimat function hipfftEstimateMany_(rank,n,inembed,istride,idist,onembed,ostride,odist,myType,batch, & workSize) & bind(c, name="hipfftEstimateMany") - use iso_c_binding import implicit none integer(c_int) :: hipfftEstimateMany_ @@ -426,7 +411,6 @@ function hipfftEstimateMany_(rank,n,inembed,istride,idist,onembed,ostride,odist, interface hipfftGetSize1d function hipfftGetSize1d_(plan,nx,myType,batch,workSize) bind(c, name="hipfftGetSize1d") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetSize1d_ @@ -442,7 +426,6 @@ function hipfftGetSize1d_(plan,nx,myType,batch,workSize) bind(c, name="hipfftGet interface hipfftGetSize2d function hipfftGetSize2d_(plan,nx,ny,myType,workSize) bind(c, name="hipfftGetSize2d") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetSize2d_ @@ -458,7 +441,6 @@ function hipfftGetSize2d_(plan,nx,ny,myType,workSize) bind(c, name="hipfftGetSiz interface hipfftGetSize3d function hipfftGetSize3d_(plan,nx,ny,nz,myType,workSize) bind(c, name="hipfftGetSize3d") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetSize3d_ @@ -477,7 +459,6 @@ function hipfftGetSize3d_(plan,nx,ny,nz,myType,workSize) bind(c, name="hipfftGet function hipfftGetSizeMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) & bind(c, name="hipfftGetSizeMany") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetSizeMany_ @@ -512,7 +493,6 @@ function hipfftGetSizeMany_(plan,rank,n,inembed,istride,idist,onembed,ostride,od function hipfftGetSizeMany64_(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) & bind(c, name="hipfftGetSizeMany64") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetSizeMany64_ @@ -545,7 +525,6 @@ function hipfftGetSizeMany64_(plan,rank,n,inembed,istride,idist,onembed,ostride, interface hipfftGetSize function hipfftGetSize_(plan,workSize) bind(c, name="hipfftGetSize") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetSize_ @@ -558,7 +537,6 @@ function hipfftGetSize_(plan,workSize) bind(c, name="hipfftGetSize") interface hipfftSetAutoAllocation function hipfftSetAutoAllocation_(plan,autoAllocate) bind(c, name="hipfftSetAutoAllocation") - use iso_c_binding import implicit none integer(c_int) :: hipfftSetAutoAllocation_ @@ -569,7 +547,6 @@ function hipfftSetAutoAllocation_(plan,autoAllocate) bind(c, name="hipfftSetAuto interface hipfftSetWorkArea function hipfftSetWorkArea_(plan,workArea) bind(c, name="hipfftSetWorkArea") - use iso_c_binding import implicit none integer(c_int) :: hipfftSetWorkArea_ @@ -580,7 +557,6 @@ function hipfftSetWorkArea_(plan,workArea) bind(c, name="hipfftSetWorkArea") interface hipfftXtSetWorkArea function hipfftXtSetWorkArea_(plan,workArea) bind(c, name="hipfftXtSetWorkArea") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetWorkArea_ @@ -591,7 +567,6 @@ function hipfftXtSetWorkArea_(plan,workArea) bind(c, name="hipfftXtSetWorkArea") interface hipfftExecC2C function hipfftExecC2C_(plan,idata,odata,direction) bind(c, name="hipfftExecC2C") - use iso_c_binding import implicit none integer(c_int) :: hipfftExecC2C_ @@ -616,7 +591,6 @@ function hipfftExecC2C_(plan,idata,odata,direction) bind(c, name="hipfftExecC2C" interface hipfftExecR2C function hipfftExecR2C_(plan,idata,odata) bind(c, name="hipfftExecR2C") - use iso_c_binding import implicit none integer(c_int) :: hipfftExecR2C_ @@ -640,7 +614,6 @@ function hipfftExecR2C_(plan,idata,odata) bind(c, name="hipfftExecR2C") interface hipfftExecC2R function hipfftExecC2R_(plan,idata,odata) bind(c, name="hipfftExecC2R") - use iso_c_binding import implicit none integer(c_int) :: hipfftExecC2R_ @@ -664,7 +637,6 @@ function hipfftExecC2R_(plan,idata,odata) bind(c, name="hipfftExecC2R") interface hipfftExecZ2Z function hipfftExecZ2Z_(plan,idata,odata,direction) bind(c, name="hipfftExecZ2Z") - use iso_c_binding import implicit none integer(c_int) :: hipfftExecZ2Z_ @@ -689,7 +661,6 @@ function hipfftExecZ2Z_(plan,idata,odata,direction) bind(c, name="hipfftExecZ2Z" interface hipfftExecD2Z function hipfftExecD2Z_(plan,idata,odata) bind(c, name="hipfftExecD2Z") - use iso_c_binding import implicit none integer(c_int) :: hipfftExecD2Z_ @@ -713,7 +684,6 @@ function hipfftExecD2Z_(plan,idata,odata) bind(c, name="hipfftExecD2Z") interface hipfftExecZ2D function hipfftExecZ2D_(plan,idata,odata) bind(c, name="hipfftExecZ2D") - use iso_c_binding import implicit none integer(c_int) :: hipfftExecZ2D_ @@ -737,7 +707,6 @@ function hipfftExecZ2D_(plan,idata,odata) bind(c, name="hipfftExecZ2D") interface hipfftSetStream function hipfftSetStream_(plan,stream) bind(c, name="hipfftSetStream") - use iso_c_binding import implicit none integer(c_int) :: hipfftSetStream_ @@ -748,7 +717,6 @@ function hipfftSetStream_(plan,stream) bind(c, name="hipfftSetStream") interface hipfftDestroy function hipfftDestroy_(plan) bind(c, name="hipfftDestroy") - use iso_c_binding import implicit none integer(c_int) :: hipfftDestroy_ @@ -758,7 +726,6 @@ function hipfftDestroy_(plan) bind(c, name="hipfftDestroy") interface hipfftGetVersion function hipfftGetVersion_(version) bind(c, name="hipfftGetVersion") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetVersion_ @@ -770,7 +737,6 @@ function hipfftGetVersion_(version) bind(c, name="hipfftGetVersion") interface hipfftGetProperty function hipfftGetProperty_(myType,myValue) bind(c, name="hipfftGetProperty") - use iso_c_binding import implicit none integer(c_int) :: hipfftGetProperty_ @@ -784,7 +750,6 @@ function hipfftGetProperty_(myType,myValue) bind(c, name="hipfftGetProperty") interface hipfftXtSetCallback function hipfftXtSetCallback_(plan,callbacks,cbtype,callbackData) & bind(c, name="hipfftXtSetCallback") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetCallback_ @@ -797,7 +762,6 @@ function hipfftXtSetCallback_(plan,callbacks,cbtype,callbackData) & interface hipfftXtClearCallback function hipfftXtClearCallback_(plan,cbtype) bind(c, name="hipfftXtClearCallback") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtClearCallback_ @@ -809,7 +773,6 @@ function hipfftXtClearCallback_(plan,cbtype) bind(c, name="hipfftXtClearCallback interface hipfftXtSetCallbackSharedSize function hipfftXtSetCallbackSharedSize_(plan,cbtype,sharedSize) & bind(c, name="hipfftXtSetCallbackSharedSize") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetCallbackSharedSize_ @@ -823,7 +786,6 @@ function hipfftXtSetCallbackSharedSize_(plan,cbtype,sharedSize) & function hipfftXtSetJITCallback_(plan,symbol_name,bitcode_data,bitcode_len_bytes,cbtype, & cbdata) & bind(c, name="hipfftXtSetJITCallback") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetJITCallback_ @@ -840,7 +802,6 @@ function hipfftXtSetJITCallback_(plan,symbol_name,bitcode_data,bitcode_len_bytes function hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & odist,outputType,batch,workSize,executionType) & bind(c, name="hipfftXtMakePlanMany") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtMakePlanMany_ @@ -861,13 +822,22 @@ function hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist,inputType,onemb end function module procedure hipfftXtMakePlanMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftXtMakePlanMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftXtMakePlanMany_rank_0,& + hipfftXtMakePlanMany_rank_1 +#endif +#endif end interface interface hipfftXtGetSizeMany function hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & odist,outputType,batch,workSize,executionType) & bind(c, name="hipfftXtGetSizeMany") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtGetSizeMany_ @@ -888,11 +858,20 @@ function hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist,inputType,onembe end function module procedure hipfftXtGetSizeMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftXtGetSizeMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftXtGetSizeMany_rank_0,& + hipfftXtGetSizeMany_rank_1 +#endif +#endif end interface interface hipfftXtExec function hipfftXtExec_(plan,input,output,direction) bind(c, name="hipfftXtExec") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExec_ @@ -905,7 +884,6 @@ function hipfftXtExec_(plan,input,output,direction) bind(c, name="hipfftXtExec") interface hipfftXtSetGPUs function hipfftXtSetGPUs_(plan,count,gpus) bind(c, name="hipfftXtSetGPUs") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetGPUs_ @@ -913,11 +891,20 @@ function hipfftXtSetGPUs_(plan,count,gpus) bind(c, name="hipfftXtSetGPUs") integer(c_int),value :: count type(c_ptr),value :: gpus end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftXtSetGPUs_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftXtSetGPUs_rank_0,& + hipfftXtSetGPUs_rank_1 +#endif +#endif end interface interface hipfftXtMalloc function hipfftXtMalloc_(plan,desc,myFormat) bind(c, name="hipfftXtMalloc") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtMalloc_ @@ -929,7 +916,6 @@ function hipfftXtMalloc_(plan,desc,myFormat) bind(c, name="hipfftXtMalloc") interface hipfftXtMemcpy function hipfftXtMemcpy_(plan,dest,src,myType) bind(c, name="hipfftXtMemcpy") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtMemcpy_ @@ -942,7 +928,6 @@ function hipfftXtMemcpy_(plan,dest,src,myType) bind(c, name="hipfftXtMemcpy") interface hipfftXtFree function hipfftXtFree_(desc) bind(c, name="hipfftXtFree") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtFree_ @@ -953,7 +938,6 @@ function hipfftXtFree_(desc) bind(c, name="hipfftXtFree") interface hipfftXtExecDescriptorC2C function hipfftXtExecDescriptorC2C_(plan,input,output,direction) & bind(c, name="hipfftXtExecDescriptorC2C") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptorC2C_ @@ -966,7 +950,6 @@ function hipfftXtExecDescriptorC2C_(plan,input,output,direction) & interface hipfftXtExecDescriptorR2C function hipfftXtExecDescriptorR2C_(plan,input,output) bind(c, name="hipfftXtExecDescriptorR2C") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptorR2C_ @@ -978,7 +961,6 @@ function hipfftXtExecDescriptorR2C_(plan,input,output) bind(c, name="hipfftXtExe interface hipfftXtExecDescriptorC2R function hipfftXtExecDescriptorC2R_(plan,input,output) bind(c, name="hipfftXtExecDescriptorC2R") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptorC2R_ @@ -991,7 +973,6 @@ function hipfftXtExecDescriptorC2R_(plan,input,output) bind(c, name="hipfftXtExe interface hipfftXtExecDescriptorZ2Z function hipfftXtExecDescriptorZ2Z_(plan,input,output,direction) & bind(c, name="hipfftXtExecDescriptorZ2Z") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptorZ2Z_ @@ -1004,7 +985,6 @@ function hipfftXtExecDescriptorZ2Z_(plan,input,output,direction) & interface hipfftXtExecDescriptorD2Z function hipfftXtExecDescriptorD2Z_(plan,input,output) bind(c, name="hipfftXtExecDescriptorD2Z") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptorD2Z_ @@ -1016,7 +996,6 @@ function hipfftXtExecDescriptorD2Z_(plan,input,output) bind(c, name="hipfftXtExe interface hipfftXtExecDescriptorZ2D function hipfftXtExecDescriptorZ2D_(plan,input,output) bind(c, name="hipfftXtExecDescriptorZ2D") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptorZ2D_ @@ -1029,7 +1008,6 @@ function hipfftXtExecDescriptorZ2D_(plan,input,output) bind(c, name="hipfftXtExe interface hipfftXtExecDescriptor function hipfftXtExecDescriptor_(plan,input,output,direction) & bind(c, name="hipfftXtExecDescriptor") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtExecDescriptor_ @@ -1042,7 +1020,6 @@ function hipfftXtExecDescriptor_(plan,input,output,direction) & interface hipfftMpAttachComm function hipfftMpAttachComm_(plan,comm_type,comm_handle) bind(c, name="hipfftMpAttachComm") - use iso_c_binding import implicit none integer(c_int) :: hipfftMpAttachComm_ @@ -1056,7 +1033,6 @@ function hipfftMpAttachComm_(plan,comm_type,comm_handle) bind(c, name="hipfftMpA function hipfftXtSetDistribution_(plan,rank,input_lower,input_upper,output_lower,output_upper, & input_stride,output_stride) & bind(c, name="hipfftXtSetDistribution") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetDistribution_ @@ -1074,7 +1050,6 @@ function hipfftXtSetDistribution_(plan,rank,input_lower,input_upper,output_lower interface hipfftXtSetSubformatDefault function hipfftXtSetSubformatDefault_(plan,subformat_forward,subformat_inverse) & bind(c, name="hipfftXtSetSubformatDefault") - use iso_c_binding import implicit none integer(c_int) :: hipfftXtSetSubformatDefault_ @@ -1090,8 +1065,9 @@ function hipfftXtSetSubformatDefault_(plan,subformat_forward,subformat_inverse) subroutine hipfftCheck(status) implicit none integer(kind(HIPFFT_SUCCESS)) :: status - character(len=:), allocatable :: name + character(len=32) :: name if (status /= HIPFFT_SUCCESS) then + name = "unknown status" select case (status) case (HIPFFT_INVALID_PLAN) name = "HIPFFT_INVALID_PLAN" @@ -1123,15 +1099,12 @@ subroutine hipfftCheck(status) name = "HIPFFT_NOT_IMPLEMENTED" case (HIPFFT_NOT_SUPPORTED) name = "HIPFFT_NOT_SUPPORTED" - case default - name = "unknown status" end select - write (*, "(a,i0,a)") "HIPFFT ERROR: " // name // " (code ", status, ")" + write (*, "(a,i0,a)") "HIPFFT ERROR: " // trim(name) // " (code ", status, ")" stop 1 end if end subroutine hipfftCheck function hipfftMakePlan1d_typed(plan,nx,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlan1d_typed type(c_ptr), value :: plan @@ -1144,7 +1117,6 @@ function hipfftMakePlan1d_typed(plan,nx,myType,batch,workSize) end function function hipfftMakePlan2d_typed(plan,nx,ny,myType,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlan2d_typed type(c_ptr), value :: plan @@ -1157,7 +1129,6 @@ function hipfftMakePlan2d_typed(plan,nx,ny,myType,workSize) end function function hipfftMakePlan3d_typed(plan,nx,ny,nz,myType,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlan3d_typed type(c_ptr), value :: plan @@ -1172,7 +1143,6 @@ function hipfftMakePlan3d_typed(plan,nx,ny,nz,myType,workSize) function hipfftMakePlanMany_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_typed type(c_ptr), value :: plan @@ -1194,7 +1164,6 @@ function hipfftMakePlanMany_typed(plan,rank,n,inembed,istride,idist,onembed,ostr function hipfftMakePlanMany64_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_typed type(c_ptr), value :: plan @@ -1215,7 +1184,6 @@ function hipfftMakePlanMany64_typed(plan,rank,n,inembed,istride,idist,onembed,os end function function hipfftEstimate1d_typed(nx,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimate1d_typed integer(c_int) :: nx @@ -1227,7 +1195,6 @@ function hipfftEstimate1d_typed(nx,myType,batch,workSize) end function function hipfftEstimate2d_typed(nx,ny,myType,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimate2d_typed integer(c_int) :: nx @@ -1239,7 +1206,6 @@ function hipfftEstimate2d_typed(nx,ny,myType,workSize) end function function hipfftEstimate3d_typed(nx,ny,nz,myType,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimate3d_typed integer(c_int) :: nx @@ -1253,7 +1219,6 @@ function hipfftEstimate3d_typed(nx,ny,nz,myType,workSize) function hipfftEstimateMany_typed(rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_typed integer(c_int) :: rank @@ -1273,7 +1238,6 @@ function hipfftEstimateMany_typed(rank,n,inembed,istride,idist,onembed,ostride,o end function function hipfftGetSize1d_typed(plan,nx,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize1d_typed type(c_ptr), value :: plan @@ -1286,7 +1250,6 @@ function hipfftGetSize1d_typed(plan,nx,myType,batch,workSize) end function function hipfftGetSize2d_typed(plan,nx,ny,myType,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize2d_typed type(c_ptr), value :: plan @@ -1299,7 +1262,6 @@ function hipfftGetSize2d_typed(plan,nx,ny,myType,workSize) end function function hipfftGetSize3d_typed(plan,nx,ny,nz,myType,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize3d_typed type(c_ptr), value :: plan @@ -1314,7 +1276,6 @@ function hipfftGetSize3d_typed(plan,nx,ny,nz,myType,workSize) function hipfftGetSizeMany_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_typed type(c_ptr), value :: plan @@ -1336,7 +1297,6 @@ function hipfftGetSizeMany_typed(plan,rank,n,inembed,istride,idist,onembed,ostri function hipfftGetSizeMany64_typed(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_typed type(c_ptr), value :: plan @@ -1357,7 +1317,6 @@ function hipfftGetSizeMany64_typed(plan,rank,n,inembed,istride,idist,onembed,ost end function function hipfftGetSize_typed(plan,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSize_typed type(c_ptr), value :: plan @@ -1367,7 +1326,6 @@ function hipfftGetSize_typed(plan,workSize) end function function hipfftGetVersion_typed(version) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetVersion_typed integer(c_int),target :: version @@ -1376,7 +1334,6 @@ function hipfftGetVersion_typed(version) end function function hipfftGetProperty_typed(myType,myValue) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetProperty_typed integer(kind(HIPFFT_MAJOR_VERSION)) :: myType @@ -1387,7 +1344,6 @@ function hipfftGetProperty_typed(myType,myValue) function hipfftXtMakePlanMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & ostride,odist,outputType,batch,workSize,executionType) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_typed type(c_ptr), value :: plan @@ -1411,7 +1367,6 @@ function hipfftXtMakePlanMany_typed(plan,rank,n,inembed,istride,idist,inputType, function hipfftXtGetSizeMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & ostride,odist,outputType,batch,workSize,executionType) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_typed type(c_ptr), value :: plan @@ -1439,7 +1394,6 @@ function hipfftXtGetSizeMany_typed(plan,rank,n,inembed,istride,idist,inputType,o #ifdef USE_ASSUMED_RANK function hipfftPlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftPlanMany_assumed_rank type(c_ptr) :: plan @@ -1461,7 +1415,6 @@ function hipfftPlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,o #else function hipfftPlanMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftPlanMany_rank_0 type(c_ptr) :: plan @@ -1482,7 +1435,6 @@ function hipfftPlanMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride function hipfftPlanMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftPlanMany_rank_1 type(c_ptr) :: plan @@ -1505,7 +1457,6 @@ function hipfftPlanMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride #ifdef USE_ASSUMED_RANK function hipfftMakePlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & odist,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_assumed_rank type(c_ptr), value :: plan @@ -1528,7 +1479,6 @@ function hipfftMakePlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,onemb #else function hipfftMakePlanMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_rank_0 type(c_ptr), value :: plan @@ -1550,7 +1500,6 @@ function hipfftMakePlanMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ost function hipfftMakePlanMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany_rank_1 type(c_ptr), value :: plan @@ -1574,7 +1523,6 @@ function hipfftMakePlanMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ost #ifdef USE_ASSUMED_RANK function hipfftMakePlanMany64_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & odist,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_assumed_rank type(c_ptr), value :: plan @@ -1597,7 +1545,6 @@ function hipfftMakePlanMany64_assumed_rank(plan,rank,n,inembed,istride,idist,one #else function hipfftMakePlanMany64_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_rank_0 type(c_ptr), value :: plan @@ -1619,7 +1566,6 @@ function hipfftMakePlanMany64_rank_0(plan,rank,n,inembed,istride,idist,onembed,o function hipfftMakePlanMany64_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftMakePlanMany64_rank_1 type(c_ptr), value :: plan @@ -1643,7 +1589,6 @@ function hipfftMakePlanMany64_rank_1(plan,rank,n,inembed,istride,idist,onembed,o #ifdef USE_ASSUMED_RANK function hipfftEstimateMany_assumed_rank(rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_assumed_rank integer(c_int) :: rank @@ -1665,7 +1610,6 @@ function hipfftEstimateMany_assumed_rank(rank,n,inembed,istride,idist,onembed,os #else function hipfftEstimateMany_rank_0(rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_rank_0 integer(c_int) :: rank @@ -1686,7 +1630,6 @@ function hipfftEstimateMany_rank_0(rank,n,inembed,istride,idist,onembed,ostride, function hipfftEstimateMany_rank_1(rank,n,inembed,istride,idist,onembed,ostride,odist,myType, & batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftEstimateMany_rank_1 integer(c_int) :: rank @@ -1709,7 +1652,6 @@ function hipfftEstimateMany_rank_1(rank,n,inembed,istride,idist,onembed,ostride, #ifdef USE_ASSUMED_RANK function hipfftGetSizeMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & odist,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_assumed_rank type(c_ptr), value :: plan @@ -1732,7 +1674,6 @@ function hipfftGetSizeMany_assumed_rank(plan,rank,n,inembed,istride,idist,onembe #else function hipfftGetSizeMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_rank_0 type(c_ptr), value :: plan @@ -1754,7 +1695,6 @@ function hipfftGetSizeMany_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostr function hipfftGetSizeMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany_rank_1 type(c_ptr), value :: plan @@ -1778,7 +1718,6 @@ function hipfftGetSizeMany_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostr #ifdef USE_ASSUMED_RANK function hipfftGetSizeMany64_assumed_rank(plan,rank,n,inembed,istride,idist,onembed,ostride, & odist,myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_assumed_rank type(c_ptr), value :: plan @@ -1801,7 +1740,6 @@ function hipfftGetSizeMany64_assumed_rank(plan,rank,n,inembed,istride,idist,onem #else function hipfftGetSizeMany64_rank_0(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_rank_0 type(c_ptr), value :: plan @@ -1823,7 +1761,6 @@ function hipfftGetSizeMany64_rank_0(plan,rank,n,inembed,istride,idist,onembed,os function hipfftGetSizeMany64_rank_1(plan,rank,n,inembed,istride,idist,onembed,ostride,odist, & myType,batch,workSize) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftGetSizeMany64_rank_1 type(c_ptr), value :: plan @@ -1846,7 +1783,6 @@ function hipfftGetSizeMany64_rank_1(plan,rank,n,inembed,istride,idist,onembed,os #endif #ifdef USE_ASSUMED_RANK function hipfftExecC2C_assumed_rank(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_assumed_rank type(c_ptr), value :: plan @@ -1859,7 +1795,6 @@ function hipfftExecC2C_assumed_rank(plan,idata,odata,direction) #else function hipfftExecC2C_rank_0(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_0 type(c_ptr), value :: plan @@ -1871,7 +1806,6 @@ function hipfftExecC2C_rank_0(plan,idata,odata,direction) end function function hipfftExecC2C_rank_1(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_1 type(c_ptr), value :: plan @@ -1883,7 +1817,6 @@ function hipfftExecC2C_rank_1(plan,idata,odata,direction) end function function hipfftExecC2C_rank_2(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_2 type(c_ptr), value :: plan @@ -1895,7 +1828,6 @@ function hipfftExecC2C_rank_2(plan,idata,odata,direction) end function function hipfftExecC2C_rank_3(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2C_rank_3 type(c_ptr), value :: plan @@ -1909,7 +1841,6 @@ function hipfftExecC2C_rank_3(plan,idata,odata,direction) #endif #ifdef USE_ASSUMED_RANK function hipfftExecR2C_assumed_rank(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_assumed_rank type(c_ptr), value :: plan @@ -1921,7 +1852,6 @@ function hipfftExecR2C_assumed_rank(plan,idata,odata) #else function hipfftExecR2C_rank_0(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_0 type(c_ptr), value :: plan @@ -1932,7 +1862,6 @@ function hipfftExecR2C_rank_0(plan,idata,odata) end function function hipfftExecR2C_rank_1(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_1 type(c_ptr), value :: plan @@ -1943,7 +1872,6 @@ function hipfftExecR2C_rank_1(plan,idata,odata) end function function hipfftExecR2C_rank_2(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_2 type(c_ptr), value :: plan @@ -1954,7 +1882,6 @@ function hipfftExecR2C_rank_2(plan,idata,odata) end function function hipfftExecR2C_rank_3(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecR2C_rank_3 type(c_ptr), value :: plan @@ -1967,7 +1894,6 @@ function hipfftExecR2C_rank_3(plan,idata,odata) #endif #ifdef USE_ASSUMED_RANK function hipfftExecC2R_assumed_rank(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_assumed_rank type(c_ptr), value :: plan @@ -1979,7 +1905,6 @@ function hipfftExecC2R_assumed_rank(plan,idata,odata) #else function hipfftExecC2R_rank_0(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_0 type(c_ptr), value :: plan @@ -1990,7 +1915,6 @@ function hipfftExecC2R_rank_0(plan,idata,odata) end function function hipfftExecC2R_rank_1(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_1 type(c_ptr), value :: plan @@ -2001,7 +1925,6 @@ function hipfftExecC2R_rank_1(plan,idata,odata) end function function hipfftExecC2R_rank_2(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_2 type(c_ptr), value :: plan @@ -2012,7 +1935,6 @@ function hipfftExecC2R_rank_2(plan,idata,odata) end function function hipfftExecC2R_rank_3(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecC2R_rank_3 type(c_ptr), value :: plan @@ -2025,7 +1947,6 @@ function hipfftExecC2R_rank_3(plan,idata,odata) #endif #ifdef USE_ASSUMED_RANK function hipfftExecZ2Z_assumed_rank(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_assumed_rank type(c_ptr), value :: plan @@ -2038,7 +1959,6 @@ function hipfftExecZ2Z_assumed_rank(plan,idata,odata,direction) #else function hipfftExecZ2Z_rank_0(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_0 type(c_ptr), value :: plan @@ -2050,7 +1970,6 @@ function hipfftExecZ2Z_rank_0(plan,idata,odata,direction) end function function hipfftExecZ2Z_rank_1(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_1 type(c_ptr), value :: plan @@ -2062,7 +1981,6 @@ function hipfftExecZ2Z_rank_1(plan,idata,odata,direction) end function function hipfftExecZ2Z_rank_2(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_2 type(c_ptr), value :: plan @@ -2074,7 +1992,6 @@ function hipfftExecZ2Z_rank_2(plan,idata,odata,direction) end function function hipfftExecZ2Z_rank_3(plan,idata,odata,direction) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2Z_rank_3 type(c_ptr), value :: plan @@ -2088,7 +2005,6 @@ function hipfftExecZ2Z_rank_3(plan,idata,odata,direction) #endif #ifdef USE_ASSUMED_RANK function hipfftExecD2Z_assumed_rank(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_assumed_rank type(c_ptr), value :: plan @@ -2100,7 +2016,6 @@ function hipfftExecD2Z_assumed_rank(plan,idata,odata) #else function hipfftExecD2Z_rank_0(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_0 type(c_ptr), value :: plan @@ -2111,7 +2026,6 @@ function hipfftExecD2Z_rank_0(plan,idata,odata) end function function hipfftExecD2Z_rank_1(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_1 type(c_ptr), value :: plan @@ -2122,7 +2036,6 @@ function hipfftExecD2Z_rank_1(plan,idata,odata) end function function hipfftExecD2Z_rank_2(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_2 type(c_ptr), value :: plan @@ -2133,7 +2046,6 @@ function hipfftExecD2Z_rank_2(plan,idata,odata) end function function hipfftExecD2Z_rank_3(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecD2Z_rank_3 type(c_ptr), value :: plan @@ -2146,7 +2058,6 @@ function hipfftExecD2Z_rank_3(plan,idata,odata) #endif #ifdef USE_ASSUMED_RANK function hipfftExecZ2D_assumed_rank(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_assumed_rank type(c_ptr), value :: plan @@ -2158,7 +2069,6 @@ function hipfftExecZ2D_assumed_rank(plan,idata,odata) #else function hipfftExecZ2D_rank_0(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_0 type(c_ptr), value :: plan @@ -2169,7 +2079,6 @@ function hipfftExecZ2D_rank_0(plan,idata,odata) end function function hipfftExecZ2D_rank_1(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_1 type(c_ptr), value :: plan @@ -2180,7 +2089,6 @@ function hipfftExecZ2D_rank_1(plan,idata,odata) end function function hipfftExecZ2D_rank_2(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_2 type(c_ptr), value :: plan @@ -2191,7 +2099,6 @@ function hipfftExecZ2D_rank_2(plan,idata,odata) end function function hipfftExecZ2D_rank_3(plan,idata,odata) - use iso_c_binding implicit none integer(kind(HIPFFT_SUCCESS)) :: hipfftExecZ2D_rank_3 type(c_ptr), value :: plan @@ -2201,6 +2108,187 @@ function hipfftExecZ2D_rank_3(plan,idata,odata) hipfftExecZ2D_rank_3 = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) end function +#endif +#ifdef USE_ASSUMED_RANK + function hipfftXtMakePlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,inputType, & + onembed,ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(..) :: n + integer(c_int64_t),target,dimension(..) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(..) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_assumed_rank = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + +#else + function hipfftXtMakePlanMany_rank_0(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target :: n + integer(c_int64_t),target :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_rank_0 = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + + function hipfftXtMakePlanMany_rank_1(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(:) :: n + integer(c_int64_t),target,dimension(:) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(:) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_rank_1 = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftXtGetSizeMany_assumed_rank(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(..) :: n + integer(c_int64_t),target,dimension(..) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(..) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_assumed_rank = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + +#else + function hipfftXtGetSizeMany_rank_0(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target :: n + integer(c_int64_t),target :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_rank_0 = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + + function hipfftXtGetSizeMany_rank_1(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(:) :: n + integer(c_int64_t),target,dimension(:) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(:) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_rank_1 = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftXtSetGPUs_assumed_rank(plan,count,gpus) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: count + integer(c_int),target,dimension(..) :: gpus + ! + hipfftXtSetGPUs_assumed_rank = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) + end function + +#else + function hipfftXtSetGPUs_rank_0(plan,count,gpus) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: count + integer(c_int),target :: gpus + ! + hipfftXtSetGPUs_rank_0 = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) + end function + + function hipfftXtSetGPUs_rank_1(plan,count,gpus) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: count + integer(c_int),target,dimension(:) :: gpus + ! + hipfftXtSetGPUs_rank_1 = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) + end function + #endif #endif end module hipfft diff --git a/bindings/fortran/hipfft/hipfftw.F90 b/bindings/fortran/hipfft/hipfftw.F90 index cfb2c9baa7f9..590e53fa3c30 100644 --- a/bindings/fortran/hipfft/hipfftw.F90 +++ b/bindings/fortran/hipfft/hipfftw.F90 @@ -55,7 +55,6 @@ module hipfftw interface fftw_malloc function fftw_malloc_(n) bind(c, name="fftw_malloc") - use iso_c_binding import implicit none type(c_ptr) :: fftw_malloc_ @@ -65,7 +64,6 @@ function fftw_malloc_(n) bind(c, name="fftw_malloc") interface fftwf_malloc function fftwf_malloc_(n) bind(c, name="fftwf_malloc") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_malloc_ @@ -75,7 +73,6 @@ function fftwf_malloc_(n) bind(c, name="fftwf_malloc") interface fftw_alloc_real function fftw_alloc_real_(n) bind(c, name="fftw_alloc_real") - use iso_c_binding import implicit none type(c_ptr) :: fftw_alloc_real_ @@ -85,7 +82,6 @@ function fftw_alloc_real_(n) bind(c, name="fftw_alloc_real") interface fftwf_alloc_real function fftwf_alloc_real_(n) bind(c, name="fftwf_alloc_real") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_alloc_real_ @@ -95,7 +91,6 @@ function fftwf_alloc_real_(n) bind(c, name="fftwf_alloc_real") interface fftw_alloc_complex function fftw_alloc_complex_(n) bind(c, name="fftw_alloc_complex") - use iso_c_binding import implicit none type(c_ptr) :: fftw_alloc_complex_ @@ -105,7 +100,6 @@ function fftw_alloc_complex_(n) bind(c, name="fftw_alloc_complex") interface fftwf_alloc_complex function fftwf_alloc_complex_(n) bind(c, name="fftwf_alloc_complex") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_alloc_complex_ @@ -115,7 +109,6 @@ function fftwf_alloc_complex_(n) bind(c, name="fftwf_alloc_complex") interface fftw_free subroutine fftw_free_(p) bind(c, name="fftw_free") - use iso_c_binding import implicit none type(c_ptr),value :: p @@ -124,7 +117,6 @@ subroutine fftw_free_(p) bind(c, name="fftw_free") interface fftwf_free subroutine fftwf_free_(p) bind(c, name="fftwf_free") - use iso_c_binding import implicit none type(c_ptr),value :: p @@ -133,7 +125,6 @@ subroutine fftwf_free_(p) bind(c, name="fftwf_free") interface fftw_plan_dft_1d function fftw_plan_dft_1d_(n,in,out,sign,flags) bind(c, name="fftw_plan_dft_1d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_1d_ @@ -147,7 +138,6 @@ function fftw_plan_dft_1d_(n,in,out,sign,flags) bind(c, name="fftw_plan_dft_1d") interface fftwf_plan_dft_1d function fftwf_plan_dft_1d_(n,in,out,sign,flags) bind(c, name="fftwf_plan_dft_1d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_1d_ @@ -161,7 +151,6 @@ function fftwf_plan_dft_1d_(n,in,out,sign,flags) bind(c, name="fftwf_plan_dft_1d interface fftw_plan_dft_2d function fftw_plan_dft_2d_(n0,n1,in,out,sign,flags) bind(c, name="fftw_plan_dft_2d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_2d_ @@ -176,7 +165,6 @@ function fftw_plan_dft_2d_(n0,n1,in,out,sign,flags) bind(c, name="fftw_plan_dft_ interface fftwf_plan_dft_2d function fftwf_plan_dft_2d_(n0,n1,in,out,sign,flags) bind(c, name="fftwf_plan_dft_2d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_2d_ @@ -191,7 +179,6 @@ function fftwf_plan_dft_2d_(n0,n1,in,out,sign,flags) bind(c, name="fftwf_plan_df interface fftw_plan_dft_3d function fftw_plan_dft_3d_(n0,n1,n2,in,out,sign,flags) bind(c, name="fftw_plan_dft_3d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_3d_ @@ -207,7 +194,6 @@ function fftw_plan_dft_3d_(n0,n1,n2,in,out,sign,flags) bind(c, name="fftw_plan_d interface fftwf_plan_dft_3d function fftwf_plan_dft_3d_(n0,n1,n2,in,out,sign,flags) bind(c, name="fftwf_plan_dft_3d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_3d_ @@ -223,7 +209,6 @@ function fftwf_plan_dft_3d_(n0,n1,n2,in,out,sign,flags) bind(c, name="fftwf_plan interface fftw_plan_dft function fftw_plan_dft_(rank,n,in,out,sign,flags) bind(c, name="fftw_plan_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_ @@ -234,11 +219,20 @@ function fftw_plan_dft_(rank,n,in,out,sign,flags) bind(c, name="fftw_plan_dft") integer(c_int),value :: sign integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_rank_0,& + fftw_plan_dft_rank_1 +#endif +#endif end interface interface fftwf_plan_dft function fftwf_plan_dft_(rank,n,in,out,sign,flags) bind(c, name="fftwf_plan_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_ @@ -249,11 +243,20 @@ function fftwf_plan_dft_(rank,n,in,out,sign,flags) bind(c, name="fftwf_plan_dft" integer(c_int),value :: sign integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_rank_0,& + fftwf_plan_dft_rank_1 +#endif +#endif end interface interface fftw_plan_dft_r2c_1d function fftw_plan_dft_r2c_1d_(n,in,out,flags) bind(c, name="fftw_plan_dft_r2c_1d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_r2c_1d_ @@ -262,11 +265,20 @@ function fftw_plan_dft_r2c_1d_(n,in,out,flags) bind(c, name="fftw_plan_dft_r2c_1 type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_r2c_1d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_r2c_1d_rank_0,& + fftw_plan_dft_r2c_1d_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_r2c_1d function fftwf_plan_dft_r2c_1d_(n,in,out,flags) bind(c, name="fftwf_plan_dft_r2c_1d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_r2c_1d_ @@ -275,11 +287,20 @@ function fftwf_plan_dft_r2c_1d_(n,in,out,flags) bind(c, name="fftwf_plan_dft_r2c type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_r2c_1d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_r2c_1d_rank_0,& + fftwf_plan_dft_r2c_1d_rank_1 +#endif +#endif end interface interface fftw_plan_dft_r2c_2d function fftw_plan_dft_r2c_2d_(n0,n1,in,out,flags) bind(c, name="fftw_plan_dft_r2c_2d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_r2c_2d_ @@ -289,11 +310,20 @@ function fftw_plan_dft_r2c_2d_(n0,n1,in,out,flags) bind(c, name="fftw_plan_dft_r type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_r2c_2d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_r2c_2d_rank_0,& + fftw_plan_dft_r2c_2d_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_r2c_2d function fftwf_plan_dft_r2c_2d_(n0,n1,in,out,flags) bind(c, name="fftwf_plan_dft_r2c_2d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_r2c_2d_ @@ -303,11 +333,20 @@ function fftwf_plan_dft_r2c_2d_(n0,n1,in,out,flags) bind(c, name="fftwf_plan_dft type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_r2c_2d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_r2c_2d_rank_0,& + fftwf_plan_dft_r2c_2d_rank_1 +#endif +#endif end interface interface fftw_plan_dft_r2c_3d function fftw_plan_dft_r2c_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftw_plan_dft_r2c_3d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_r2c_3d_ @@ -318,11 +357,20 @@ function fftw_plan_dft_r2c_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftw_plan_df type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_r2c_3d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_r2c_3d_rank_0,& + fftw_plan_dft_r2c_3d_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_r2c_3d function fftwf_plan_dft_r2c_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftwf_plan_dft_r2c_3d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_r2c_3d_ @@ -333,11 +381,20 @@ function fftwf_plan_dft_r2c_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftwf_plan_ type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_r2c_3d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_r2c_3d_rank_0,& + fftwf_plan_dft_r2c_3d_rank_1 +#endif +#endif end interface interface fftw_plan_dft_r2c function fftw_plan_dft_r2c_(rank,n,in,out,flags) bind(c, name="fftw_plan_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_r2c_ @@ -347,11 +404,20 @@ function fftw_plan_dft_r2c_(rank,n,in,out,flags) bind(c, name="fftw_plan_dft_r2c type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_r2c_rank_0,& + fftw_plan_dft_r2c_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_r2c function fftwf_plan_dft_r2c_(rank,n,in,out,flags) bind(c, name="fftwf_plan_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_r2c_ @@ -361,11 +427,20 @@ function fftwf_plan_dft_r2c_(rank,n,in,out,flags) bind(c, name="fftwf_plan_dft_r type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_r2c_rank_0,& + fftwf_plan_dft_r2c_rank_1 +#endif +#endif end interface interface fftw_plan_dft_c2r_1d function fftw_plan_dft_c2r_1d_(n,in,out,flags) bind(c, name="fftw_plan_dft_c2r_1d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_c2r_1d_ @@ -374,11 +449,20 @@ function fftw_plan_dft_c2r_1d_(n,in,out,flags) bind(c, name="fftw_plan_dft_c2r_1 type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_c2r_1d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_c2r_1d_rank_0,& + fftw_plan_dft_c2r_1d_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_c2r_1d function fftwf_plan_dft_c2r_1d_(n,in,out,flags) bind(c, name="fftwf_plan_dft_c2r_1d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_c2r_1d_ @@ -387,11 +471,20 @@ function fftwf_plan_dft_c2r_1d_(n,in,out,flags) bind(c, name="fftwf_plan_dft_c2r type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_c2r_1d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_c2r_1d_rank_0,& + fftwf_plan_dft_c2r_1d_rank_1 +#endif +#endif end interface interface fftw_plan_dft_c2r_2d function fftw_plan_dft_c2r_2d_(n0,n1,in,out,flags) bind(c, name="fftw_plan_dft_c2r_2d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_c2r_2d_ @@ -401,11 +494,20 @@ function fftw_plan_dft_c2r_2d_(n0,n1,in,out,flags) bind(c, name="fftw_plan_dft_c type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_c2r_2d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_c2r_2d_rank_0,& + fftw_plan_dft_c2r_2d_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_c2r_2d function fftwf_plan_dft_c2r_2d_(n0,n1,in,out,flags) bind(c, name="fftwf_plan_dft_c2r_2d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_c2r_2d_ @@ -415,11 +517,20 @@ function fftwf_plan_dft_c2r_2d_(n0,n1,in,out,flags) bind(c, name="fftwf_plan_dft type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_c2r_2d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_c2r_2d_rank_0,& + fftwf_plan_dft_c2r_2d_rank_1 +#endif +#endif end interface interface fftw_plan_dft_c2r_3d function fftw_plan_dft_c2r_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftw_plan_dft_c2r_3d") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_c2r_3d_ @@ -430,11 +541,20 @@ function fftw_plan_dft_c2r_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftw_plan_df type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_c2r_3d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_c2r_3d_rank_0,& + fftw_plan_dft_c2r_3d_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_c2r_3d function fftwf_plan_dft_c2r_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftwf_plan_dft_c2r_3d") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_c2r_3d_ @@ -445,11 +565,20 @@ function fftwf_plan_dft_c2r_3d_(n0,n1,n2,in,out,flags) bind(c, name="fftwf_plan_ type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_c2r_3d_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_c2r_3d_rank_0,& + fftwf_plan_dft_c2r_3d_rank_1 +#endif +#endif end interface interface fftw_plan_dft_c2r function fftw_plan_dft_c2r_(rank,n,in,out,flags) bind(c, name="fftw_plan_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_dft_c2r_ @@ -459,11 +588,20 @@ function fftw_plan_dft_c2r_(rank,n,in,out,flags) bind(c, name="fftw_plan_dft_c2r type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_dft_c2r_rank_0,& + fftw_plan_dft_c2r_rank_1 +#endif +#endif end interface interface fftwf_plan_dft_c2r function fftwf_plan_dft_c2r_(rank,n,in,out,flags) bind(c, name="fftwf_plan_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_dft_c2r_ @@ -473,13 +611,22 @@ function fftwf_plan_dft_c2r_(rank,n,in,out,flags) bind(c, name="fftwf_plan_dft_c type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_dft_c2r_rank_0,& + fftwf_plan_dft_c2r_rank_1 +#endif +#endif end interface interface fftw_plan_many_dft function fftw_plan_many_dft_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & odist,sign,flags) & bind(c, name="fftw_plan_many_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_many_dft_ @@ -497,13 +644,22 @@ function fftw_plan_many_dft_(rank,n,howmany,in,inembed,istride,idist,out,onembed integer(c_int),value :: sign integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_many_dft_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_many_dft_rank_0,& + fftw_plan_many_dft_rank_1 +#endif +#endif end interface interface fftwf_plan_many_dft function fftwf_plan_many_dft_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & odist,sign,flags) & bind(c, name="fftwf_plan_many_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_many_dft_ @@ -521,13 +677,22 @@ function fftwf_plan_many_dft_(rank,n,howmany,in,inembed,istride,idist,out,onembe integer(c_int),value :: sign integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_many_dft_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_many_dft_rank_0,& + fftwf_plan_many_dft_rank_1 +#endif +#endif end interface interface fftw_plan_many_dft_r2c function fftw_plan_many_dft_r2c_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & odist,flags) & bind(c, name="fftw_plan_many_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_many_dft_r2c_ @@ -544,13 +709,22 @@ function fftw_plan_many_dft_r2c_(rank,n,howmany,in,inembed,istride,idist,out,one integer(c_int),value :: odist integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_many_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_many_dft_r2c_rank_0,& + fftw_plan_many_dft_r2c_rank_1 +#endif +#endif end interface interface fftwf_plan_many_dft_r2c function fftwf_plan_many_dft_r2c_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & odist,flags) & bind(c, name="fftwf_plan_many_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_many_dft_r2c_ @@ -567,13 +741,22 @@ function fftwf_plan_many_dft_r2c_(rank,n,howmany,in,inembed,istride,idist,out,on integer(c_int),value :: odist integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_many_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_many_dft_r2c_rank_0,& + fftwf_plan_many_dft_r2c_rank_1 +#endif +#endif end interface interface fftw_plan_many_dft_c2r function fftw_plan_many_dft_c2r_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & odist,flags) & bind(c, name="fftw_plan_many_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_many_dft_c2r_ @@ -590,13 +773,22 @@ function fftw_plan_many_dft_c2r_(rank,n,howmany,in,inembed,istride,idist,out,one integer(c_int),value :: odist integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_many_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_many_dft_c2r_rank_0,& + fftw_plan_many_dft_c2r_rank_1 +#endif +#endif end interface interface fftwf_plan_many_dft_c2r function fftwf_plan_many_dft_c2r_(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride, & odist,flags) & bind(c, name="fftwf_plan_many_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_many_dft_c2r_ @@ -613,12 +805,21 @@ function fftwf_plan_many_dft_c2r_(rank,n,howmany,in,inembed,istride,idist,out,on integer(c_int),value :: odist integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_many_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_many_dft_c2r_rank_0,& + fftwf_plan_many_dft_c2r_rank_1 +#endif +#endif end interface interface fftw_plan_guru_dft function fftw_plan_guru_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & bind(c, name="fftw_plan_guru_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_guru_dft_ @@ -636,7 +837,6 @@ function fftw_plan_guru_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,fla interface fftwf_plan_guru_dft function fftwf_plan_guru_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & bind(c, name="fftwf_plan_guru_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_guru_dft_ @@ -654,7 +854,6 @@ function fftwf_plan_guru_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,fl interface fftw_plan_guru_dft_r2c function fftw_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftw_plan_guru_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_guru_dft_r2c_ @@ -666,12 +865,21 @@ function fftw_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flag type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_guru_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_guru_dft_r2c_rank_0,& + fftw_plan_guru_dft_r2c_rank_1 +#endif +#endif end interface interface fftwf_plan_guru_dft_r2c function fftwf_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftwf_plan_guru_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_guru_dft_r2c_ @@ -683,12 +891,21 @@ function fftwf_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,fla type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_guru_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_guru_dft_r2c_rank_0,& + fftwf_plan_guru_dft_r2c_rank_1 +#endif +#endif end interface interface fftw_plan_guru_dft_c2r function fftw_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftw_plan_guru_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_guru_dft_c2r_ @@ -700,12 +917,21 @@ function fftw_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flag type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_guru_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_guru_dft_c2r_rank_0,& + fftw_plan_guru_dft_c2r_rank_1 +#endif +#endif end interface interface fftwf_plan_guru_dft_c2r function fftwf_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftwf_plan_guru_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_guru_dft_c2r_ @@ -717,12 +943,21 @@ function fftwf_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,fla type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_guru_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_guru_dft_c2r_rank_0,& + fftwf_plan_guru_dft_c2r_rank_1 +#endif +#endif end interface interface fftw_plan_guru64_dft function fftw_plan_guru64_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & bind(c, name="fftw_plan_guru64_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_guru64_dft_ @@ -740,7 +975,6 @@ function fftw_plan_guru64_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,f interface fftwf_plan_guru64_dft function fftwf_plan_guru64_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & bind(c, name="fftwf_plan_guru64_dft") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_guru64_dft_ @@ -758,7 +992,6 @@ function fftwf_plan_guru64_dft_(rank,dims,howmany_rank,howmany_dims,in,out,sign, interface fftw_plan_guru64_dft_r2c function fftw_plan_guru64_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftw_plan_guru64_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_guru64_dft_r2c_ @@ -770,12 +1003,21 @@ function fftw_plan_guru64_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,fl type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_guru64_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_guru64_dft_r2c_rank_0,& + fftw_plan_guru64_dft_r2c_rank_1 +#endif +#endif end interface interface fftwf_plan_guru64_dft_r2c function fftwf_plan_guru64_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftwf_plan_guru64_dft_r2c") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_guru64_dft_r2c_ @@ -787,12 +1029,21 @@ function fftwf_plan_guru64_dft_r2c_(rank,dims,howmany_rank,howmany_dims,in,out,f type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_guru64_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_guru64_dft_r2c_rank_0,& + fftwf_plan_guru64_dft_r2c_rank_1 +#endif +#endif end interface interface fftw_plan_guru64_dft_c2r function fftw_plan_guru64_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftw_plan_guru64_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftw_plan_guru64_dft_c2r_ @@ -804,12 +1055,21 @@ function fftw_plan_guru64_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,fl type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftw_plan_guru64_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_plan_guru64_dft_c2r_rank_0,& + fftw_plan_guru64_dft_c2r_rank_1 +#endif +#endif end interface interface fftwf_plan_guru64_dft_c2r function fftwf_plan_guru64_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,flags) & bind(c, name="fftwf_plan_guru64_dft_c2r") - use iso_c_binding import implicit none type(c_ptr) :: fftwf_plan_guru64_dft_c2r_ @@ -821,11 +1081,20 @@ function fftwf_plan_guru64_dft_c2r_(rank,dims,howmany_rank,howmany_dims,in,out,f type(c_ptr),value :: out integer(c_int),value :: flags end function + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_plan_guru64_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_plan_guru64_dft_c2r_rank_0,& + fftwf_plan_guru64_dft_c2r_rank_1 +#endif +#endif end interface interface fftw_execute subroutine fftw_execute_(plan) bind(c, name="fftw_execute") - use iso_c_binding import implicit none type(c_ptr),value :: plan @@ -834,7 +1103,6 @@ subroutine fftw_execute_(plan) bind(c, name="fftw_execute") interface fftwf_execute subroutine fftwf_execute_(plan) bind(c, name="fftwf_execute") - use iso_c_binding import implicit none type(c_ptr),value :: plan @@ -843,7 +1111,6 @@ subroutine fftwf_execute_(plan) bind(c, name="fftwf_execute") interface fftw_execute_dft subroutine fftw_execute_dft_(plan,in,out) bind(c, name="fftw_execute_dft") - use iso_c_binding import implicit none type(c_ptr),value :: plan @@ -854,7 +1121,6 @@ subroutine fftw_execute_dft_(plan,in,out) bind(c, name="fftw_execute_dft") interface fftwf_execute_dft subroutine fftwf_execute_dft_(plan,in,out) bind(c, name="fftwf_execute_dft") - use iso_c_binding import implicit none type(c_ptr),value :: plan @@ -865,51 +1131,86 @@ subroutine fftwf_execute_dft_(plan,in,out) bind(c, name="fftwf_execute_dft") interface fftw_execute_dft_r2c subroutine fftw_execute_dft_r2c_(plan,in,out) bind(c, name="fftw_execute_dft_r2c") - use iso_c_binding import implicit none type(c_ptr),value :: plan type(c_ptr),value :: in type(c_ptr),value :: out end subroutine + +#ifdef USE_ASSUMED_RANK + module procedure fftw_execute_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_execute_dft_r2c_rank_0,& + fftw_execute_dft_r2c_rank_1 +#endif +#endif end interface interface fftwf_execute_dft_r2c subroutine fftwf_execute_dft_r2c_(plan,in,out) bind(c, name="fftwf_execute_dft_r2c") - use iso_c_binding import implicit none type(c_ptr),value :: plan type(c_ptr),value :: in type(c_ptr),value :: out end subroutine + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_execute_dft_r2c_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_execute_dft_r2c_rank_0,& + fftwf_execute_dft_r2c_rank_1 +#endif +#endif end interface interface fftw_execute_dft_c2r subroutine fftw_execute_dft_c2r_(plan,in,out) bind(c, name="fftw_execute_dft_c2r") - use iso_c_binding import implicit none type(c_ptr),value :: plan type(c_ptr),value :: in type(c_ptr),value :: out end subroutine + +#ifdef USE_ASSUMED_RANK + module procedure fftw_execute_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_execute_dft_c2r_rank_0,& + fftw_execute_dft_c2r_rank_1 +#endif +#endif end interface interface fftwf_execute_dft_c2r subroutine fftwf_execute_dft_c2r_(plan,in,out) bind(c, name="fftwf_execute_dft_c2r") - use iso_c_binding import implicit none type(c_ptr),value :: plan type(c_ptr),value :: in type(c_ptr),value :: out end subroutine + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_execute_dft_c2r_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_execute_dft_c2r_rank_0,& + fftwf_execute_dft_c2r_rank_1 +#endif +#endif end interface interface fftw_destroy_plan subroutine fftw_destroy_plan_(plan) bind(c, name="fftw_destroy_plan") - use iso_c_binding import implicit none type(c_ptr),value :: plan @@ -918,7 +1219,6 @@ subroutine fftw_destroy_plan_(plan) bind(c, name="fftw_destroy_plan") interface fftwf_destroy_plan subroutine fftwf_destroy_plan_(plan) bind(c, name="fftwf_destroy_plan") - use iso_c_binding import implicit none type(c_ptr),value :: plan @@ -927,7 +1227,6 @@ subroutine fftwf_destroy_plan_(plan) bind(c, name="fftwf_destroy_plan") interface fftw_print_plan subroutine fftw_print_plan_(arg1) bind(c, name="fftw_print_plan") - use iso_c_binding import implicit none type(c_ptr),value :: arg1 @@ -936,7 +1235,6 @@ subroutine fftw_print_plan_(arg1) bind(c, name="fftw_print_plan") interface fftwf_print_plan subroutine fftwf_print_plan_(arg1) bind(c, name="fftwf_print_plan") - use iso_c_binding import implicit none type(c_ptr),value :: arg1 @@ -945,7 +1243,6 @@ subroutine fftwf_print_plan_(arg1) bind(c, name="fftwf_print_plan") interface fftw_set_timelimit subroutine fftw_set_timelimit_(arg1) bind(c, name="fftw_set_timelimit") - use iso_c_binding import implicit none real(c_double),value :: arg1 @@ -954,7 +1251,6 @@ subroutine fftw_set_timelimit_(arg1) bind(c, name="fftw_set_timelimit") interface fftwf_set_timelimit subroutine fftwf_set_timelimit_(arg1) bind(c, name="fftwf_set_timelimit") - use iso_c_binding import implicit none real(c_double),value :: arg1 @@ -963,7 +1259,6 @@ subroutine fftwf_set_timelimit_(arg1) bind(c, name="fftwf_set_timelimit") interface fftw_cost function fftw_cost_(arg1) bind(c, name="fftw_cost") - use iso_c_binding import implicit none real(c_double) :: fftw_cost_ @@ -973,7 +1268,6 @@ function fftw_cost_(arg1) bind(c, name="fftw_cost") interface fftwf_cost function fftwf_cost_(arg1) bind(c, name="fftwf_cost") - use iso_c_binding import implicit none real(c_double) :: fftwf_cost_ @@ -983,7 +1277,6 @@ function fftwf_cost_(arg1) bind(c, name="fftwf_cost") interface fftw_flops subroutine fftw_flops_(arg1,arg2,arg3,arg4) bind(c, name="fftw_flops") - use iso_c_binding import implicit none type(c_ptr),value :: arg1 @@ -991,11 +1284,20 @@ subroutine fftw_flops_(arg1,arg2,arg3,arg4) bind(c, name="fftw_flops") type(c_ptr),value :: arg3 type(c_ptr),value :: arg4 end subroutine + +#ifdef USE_ASSUMED_RANK + module procedure fftw_flops_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftw_flops_rank_0,& + fftw_flops_rank_1 +#endif +#endif end interface interface fftwf_flops subroutine fftwf_flops_(arg1,arg2,arg3,arg4) bind(c, name="fftwf_flops") - use iso_c_binding import implicit none type(c_ptr),value :: arg1 @@ -1003,11 +1305,20 @@ subroutine fftwf_flops_(arg1,arg2,arg3,arg4) bind(c, name="fftwf_flops") type(c_ptr),value :: arg3 type(c_ptr),value :: arg4 end subroutine + +#ifdef USE_ASSUMED_RANK + module procedure fftwf_flops_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + fftwf_flops_rank_0,& + fftwf_flops_rank_1 +#endif +#endif end interface interface fftw_cleanup subroutine fftw_cleanup_() bind(c, name="fftw_cleanup") - use iso_c_binding import implicit none end subroutine @@ -1015,10 +1326,1696 @@ subroutine fftw_cleanup_() bind(c, name="fftw_cleanup") interface fftwf_cleanup subroutine fftwf_cleanup_() bind(c, name="fftwf_cleanup") - use iso_c_binding import implicit none end subroutine end interface + +#if defined(USE_ASSUMED_SHAPE) || defined(USE_ASSUMED_RANK) + contains + +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_assumed_rank(rank,n,in,out,sign,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + type(c_ptr), value :: in + type(c_ptr), value :: out + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftw_plan_dft_assumed_rank = fftw_plan_dft_(rank,c_loc(n),in,out,sign,flags) + end function + +#else + function fftw_plan_dft_rank_0(rank,n,in,out,sign,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + type(c_ptr), value :: in + type(c_ptr), value :: out + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftw_plan_dft_rank_0 = fftw_plan_dft_(rank,c_loc(n),in,out,sign,flags) + end function + + function fftw_plan_dft_rank_1(rank,n,in,out,sign,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + type(c_ptr), value :: in + type(c_ptr), value :: out + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftw_plan_dft_rank_1 = fftw_plan_dft_(rank,c_loc(n),in,out,sign,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_assumed_rank(rank,n,in,out,sign,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + type(c_ptr), value :: in + type(c_ptr), value :: out + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftwf_plan_dft_assumed_rank = fftwf_plan_dft_(rank,c_loc(n),in,out,sign,flags) + end function + +#else + function fftwf_plan_dft_rank_0(rank,n,in,out,sign,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + type(c_ptr), value :: in + type(c_ptr), value :: out + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftwf_plan_dft_rank_0 = fftwf_plan_dft_(rank,c_loc(n),in,out,sign,flags) + end function + + function fftwf_plan_dft_rank_1(rank,n,in,out,sign,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + type(c_ptr), value :: in + type(c_ptr), value :: out + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftwf_plan_dft_rank_1 = fftwf_plan_dft_(rank,c_loc(n),in,out,sign,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_r2c_1d_assumed_rank(n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_1d_assumed_rank + integer(c_int) :: n + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_1d_assumed_rank = fftw_plan_dft_r2c_1d_(n,c_loc(in),out,flags) + end function + +#else + function fftw_plan_dft_r2c_1d_rank_0(n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_1d_rank_0 + integer(c_int) :: n + real(c_double),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_1d_rank_0 = fftw_plan_dft_r2c_1d_(n,c_loc(in),out,flags) + end function + + function fftw_plan_dft_r2c_1d_rank_1(n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_1d_rank_1 + integer(c_int) :: n + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_1d_rank_1 = fftw_plan_dft_r2c_1d_(n,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_r2c_1d_assumed_rank(n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_1d_assumed_rank + integer(c_int) :: n + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_1d_assumed_rank = fftwf_plan_dft_r2c_1d_(n,c_loc(in),out,flags) + end function + +#else + function fftwf_plan_dft_r2c_1d_rank_0(n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_1d_rank_0 + integer(c_int) :: n + real(c_float),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_1d_rank_0 = fftwf_plan_dft_r2c_1d_(n,c_loc(in),out,flags) + end function + + function fftwf_plan_dft_r2c_1d_rank_1(n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_1d_rank_1 + integer(c_int) :: n + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_1d_rank_1 = fftwf_plan_dft_r2c_1d_(n,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_r2c_2d_assumed_rank(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_2d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_2d_assumed_rank = fftw_plan_dft_r2c_2d_(n0,n1,c_loc(in),out,flags) + end function + +#else + function fftw_plan_dft_r2c_2d_rank_0(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_2d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + real(c_double),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_2d_rank_0 = fftw_plan_dft_r2c_2d_(n0,n1,c_loc(in),out,flags) + end function + + function fftw_plan_dft_r2c_2d_rank_1(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_2d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_2d_rank_1 = fftw_plan_dft_r2c_2d_(n0,n1,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_r2c_2d_assumed_rank(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_2d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_2d_assumed_rank = fftwf_plan_dft_r2c_2d_(n0,n1,c_loc(in),out,flags) + end function + +#else + function fftwf_plan_dft_r2c_2d_rank_0(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_2d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + real(c_float),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_2d_rank_0 = fftwf_plan_dft_r2c_2d_(n0,n1,c_loc(in),out,flags) + end function + + function fftwf_plan_dft_r2c_2d_rank_1(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_2d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_2d_rank_1 = fftwf_plan_dft_r2c_2d_(n0,n1,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_r2c_3d_assumed_rank(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_3d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_3d_assumed_rank = fftw_plan_dft_r2c_3d_(n0,n1,n2,c_loc(in),out,flags) + end function + +#else + function fftw_plan_dft_r2c_3d_rank_0(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_3d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + real(c_double),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_3d_rank_0 = fftw_plan_dft_r2c_3d_(n0,n1,n2,c_loc(in),out,flags) + end function + + function fftw_plan_dft_r2c_3d_rank_1(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_3d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_3d_rank_1 = fftw_plan_dft_r2c_3d_(n0,n1,n2,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_r2c_3d_assumed_rank(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_3d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_3d_assumed_rank = fftwf_plan_dft_r2c_3d_(n0,n1,n2,c_loc(in),out,flags) + end function + +#else + function fftwf_plan_dft_r2c_3d_rank_0(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_3d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + real(c_float),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_3d_rank_0 = fftwf_plan_dft_r2c_3d_(n0,n1,n2,c_loc(in),out,flags) + end function + + function fftwf_plan_dft_r2c_3d_rank_1(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_3d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_3d_rank_1 = fftwf_plan_dft_r2c_3d_(n0,n1,n2,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_r2c_assumed_rank(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_assumed_rank = fftw_plan_dft_r2c_(rank,c_loc(n),c_loc(in),out,flags) + end function + +#else + function fftw_plan_dft_r2c_rank_0(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + real(c_double),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_rank_0 = fftw_plan_dft_r2c_(rank,c_loc(n),c_loc(in),out,flags) + end function + + function fftw_plan_dft_r2c_rank_1(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_r2c_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_dft_r2c_rank_1 = fftw_plan_dft_r2c_(rank,c_loc(n),c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_r2c_assumed_rank(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_assumed_rank = fftwf_plan_dft_r2c_(rank,c_loc(n),c_loc(in),out,flags) + end function + +#else + function fftwf_plan_dft_r2c_rank_0(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + real(c_float),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_rank_0 = fftwf_plan_dft_r2c_(rank,c_loc(n),c_loc(in),out,flags) + end function + + function fftwf_plan_dft_r2c_rank_1(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_r2c_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_r2c_rank_1 = fftwf_plan_dft_r2c_(rank,c_loc(n),c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_c2r_1d_assumed_rank(n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_1d_assumed_rank + integer(c_int) :: n + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_1d_assumed_rank = fftw_plan_dft_c2r_1d_(n,in,c_loc(out),flags) + end function + +#else + function fftw_plan_dft_c2r_1d_rank_0(n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_1d_rank_0 + integer(c_int) :: n + type(c_ptr), value :: in + real(c_double),target :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_1d_rank_0 = fftw_plan_dft_c2r_1d_(n,in,c_loc(out),flags) + end function + + function fftw_plan_dft_c2r_1d_rank_1(n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_1d_rank_1 + integer(c_int) :: n + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_1d_rank_1 = fftw_plan_dft_c2r_1d_(n,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_c2r_1d_assumed_rank(n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_1d_assumed_rank + integer(c_int) :: n + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_1d_assumed_rank = fftwf_plan_dft_c2r_1d_(n,in,c_loc(out),flags) + end function + +#else + function fftwf_plan_dft_c2r_1d_rank_0(n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_1d_rank_0 + integer(c_int) :: n + type(c_ptr), value :: in + real(c_float),target :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_1d_rank_0 = fftwf_plan_dft_c2r_1d_(n,in,c_loc(out),flags) + end function + + function fftwf_plan_dft_c2r_1d_rank_1(n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_1d_rank_1 + integer(c_int) :: n + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_1d_rank_1 = fftwf_plan_dft_c2r_1d_(n,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_c2r_2d_assumed_rank(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_2d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_2d_assumed_rank = fftw_plan_dft_c2r_2d_(n0,n1,in,c_loc(out),flags) + end function + +#else + function fftw_plan_dft_c2r_2d_rank_0(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_2d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + type(c_ptr), value :: in + real(c_double),target :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_2d_rank_0 = fftw_plan_dft_c2r_2d_(n0,n1,in,c_loc(out),flags) + end function + + function fftw_plan_dft_c2r_2d_rank_1(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_2d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_2d_rank_1 = fftw_plan_dft_c2r_2d_(n0,n1,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_c2r_2d_assumed_rank(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_2d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_2d_assumed_rank = fftwf_plan_dft_c2r_2d_(n0,n1,in,c_loc(out),flags) + end function + +#else + function fftwf_plan_dft_c2r_2d_rank_0(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_2d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + type(c_ptr), value :: in + real(c_float),target :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_2d_rank_0 = fftwf_plan_dft_c2r_2d_(n0,n1,in,c_loc(out),flags) + end function + + function fftwf_plan_dft_c2r_2d_rank_1(n0,n1,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_2d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_2d_rank_1 = fftwf_plan_dft_c2r_2d_(n0,n1,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_c2r_3d_assumed_rank(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_3d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_3d_assumed_rank = fftw_plan_dft_c2r_3d_(n0,n1,n2,in,c_loc(out),flags) + end function + +#else + function fftw_plan_dft_c2r_3d_rank_0(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_3d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + type(c_ptr), value :: in + real(c_double),target :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_3d_rank_0 = fftw_plan_dft_c2r_3d_(n0,n1,n2,in,c_loc(out),flags) + end function + + function fftw_plan_dft_c2r_3d_rank_1(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_3d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_3d_rank_1 = fftw_plan_dft_c2r_3d_(n0,n1,n2,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_c2r_3d_assumed_rank(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_3d_assumed_rank + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_3d_assumed_rank = fftwf_plan_dft_c2r_3d_(n0,n1,n2,in,c_loc(out),flags) + end function + +#else + function fftwf_plan_dft_c2r_3d_rank_0(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_3d_rank_0 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + type(c_ptr), value :: in + real(c_float),target :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_3d_rank_0 = fftwf_plan_dft_c2r_3d_(n0,n1,n2,in,c_loc(out),flags) + end function + + function fftwf_plan_dft_c2r_3d_rank_1(n0,n1,n2,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_3d_rank_1 + integer(c_int) :: n0 + integer(c_int) :: n1 + integer(c_int) :: n2 + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_3d_rank_1 = fftwf_plan_dft_c2r_3d_(n0,n1,n2,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_dft_c2r_assumed_rank(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_assumed_rank = fftw_plan_dft_c2r_(rank,c_loc(n),in,c_loc(out),flags) + end function + +#else + function fftw_plan_dft_c2r_rank_0(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + type(c_ptr), value :: in + real(c_double),target :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_rank_0 = fftw_plan_dft_c2r_(rank,c_loc(n),in,c_loc(out),flags) + end function + + function fftw_plan_dft_c2r_rank_1(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_dft_c2r_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftw_plan_dft_c2r_rank_1 = fftw_plan_dft_c2r_(rank,c_loc(n),in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_dft_c2r_assumed_rank(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_assumed_rank = fftwf_plan_dft_c2r_(rank,c_loc(n),in,c_loc(out),flags) + end function + +#else + function fftwf_plan_dft_c2r_rank_0(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + type(c_ptr), value :: in + real(c_float),target :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_rank_0 = fftwf_plan_dft_c2r_(rank,c_loc(n),in,c_loc(out),flags) + end function + + function fftwf_plan_dft_c2r_rank_1(rank,n,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_dft_c2r_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftwf_plan_dft_c2r_rank_1 = fftwf_plan_dft_c2r_(rank,c_loc(n),in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_many_dft_assumed_rank(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,sign,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftw_plan_many_dft_assumed_rank = fftw_plan_many_dft_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,sign,flags) + end function + +#else + function fftw_plan_many_dft_rank_0(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,sign,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftw_plan_many_dft_rank_0 = fftw_plan_many_dft_(rank,c_loc(n),howmany,in,c_loc(inembed), & + istride,idist,out,c_loc(onembed),ostride,odist,sign,flags) + end function + + function fftw_plan_many_dft_rank_1(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,sign,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftw_plan_many_dft_rank_1 = fftw_plan_many_dft_(rank,c_loc(n),howmany,in,c_loc(inembed), & + istride,idist,out,c_loc(onembed),ostride,odist,sign,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_many_dft_assumed_rank(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,sign,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftwf_plan_many_dft_assumed_rank = fftwf_plan_many_dft_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,sign,flags) + end function + +#else + function fftwf_plan_many_dft_rank_0(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,sign,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftwf_plan_many_dft_rank_0 = fftwf_plan_many_dft_(rank,c_loc(n),howmany,in,c_loc(inembed), & + istride,idist,out,c_loc(onembed),ostride,odist,sign,flags) + end function + + function fftwf_plan_many_dft_rank_1(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,sign,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: sign + integer(c_int) :: flags + ! + fftwf_plan_many_dft_rank_1 = fftwf_plan_many_dft_(rank,c_loc(n),howmany,in,c_loc(inembed), & + istride,idist,out,c_loc(onembed),ostride,odist,sign,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_many_dft_r2c_assumed_rank(rank,n,howmany,in,inembed,istride,idist,out, & + onembed,ostride,odist,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_r2c_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int) :: howmany + real(c_double),target,dimension(..) :: in + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftw_plan_many_dft_r2c_assumed_rank = fftw_plan_many_dft_r2c_(rank,c_loc(n),howmany, & + c_loc(in),c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,flags) + end function + +#else + function fftw_plan_many_dft_r2c_rank_0(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_r2c_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int) :: howmany + real(c_double),target :: in + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftw_plan_many_dft_r2c_rank_0 = fftw_plan_many_dft_r2c_(rank,c_loc(n),howmany,c_loc(in), & + c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,flags) + end function + + function fftw_plan_many_dft_r2c_rank_1(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_r2c_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int) :: howmany + real(c_double),target,dimension(:) :: in + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftw_plan_many_dft_r2c_rank_1 = fftw_plan_many_dft_r2c_(rank,c_loc(n),howmany,c_loc(in), & + c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_many_dft_r2c_assumed_rank(rank,n,howmany,in,inembed,istride,idist,out, & + onembed,ostride,odist,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_r2c_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int) :: howmany + real(c_float),target,dimension(..) :: in + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftwf_plan_many_dft_r2c_assumed_rank = fftwf_plan_many_dft_r2c_(rank,c_loc(n),howmany, & + c_loc(in),c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,flags) + end function + +#else + function fftwf_plan_many_dft_r2c_rank_0(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_r2c_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int) :: howmany + real(c_float),target :: in + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftwf_plan_many_dft_r2c_rank_0 = fftwf_plan_many_dft_r2c_(rank,c_loc(n),howmany,c_loc(in), & + c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,flags) + end function + + function fftwf_plan_many_dft_r2c_rank_1(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_r2c_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int) :: howmany + real(c_float),target,dimension(:) :: in + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + type(c_ptr), value :: out + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftwf_plan_many_dft_r2c_rank_1 = fftwf_plan_many_dft_r2c_(rank,c_loc(n),howmany,c_loc(in), & + c_loc(inembed),istride,idist,out,c_loc(onembed),ostride,odist,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_many_dft_c2r_assumed_rank(rank,n,howmany,in,inembed,istride,idist,out, & + onembed,ostride,odist,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_c2r_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + real(c_double),target,dimension(..) :: out + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftw_plan_many_dft_c2r_assumed_rank = fftw_plan_many_dft_c2r_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,c_loc(out),c_loc(onembed),ostride,odist,flags) + end function + +#else + function fftw_plan_many_dft_c2r_rank_0(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_c2r_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + real(c_double),target :: out + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftw_plan_many_dft_c2r_rank_0 = fftw_plan_many_dft_c2r_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,c_loc(out),c_loc(onembed),ostride,odist,flags) + end function + + function fftw_plan_many_dft_c2r_rank_1(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftw_plan_many_dft_c2r_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + real(c_double),target,dimension(:) :: out + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftw_plan_many_dft_c2r_rank_1 = fftw_plan_many_dft_c2r_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,c_loc(out),c_loc(onembed),ostride,odist,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_many_dft_c2r_assumed_rank(rank,n,howmany,in,inembed,istride,idist,out, & + onembed,ostride,odist,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_c2r_assumed_rank + integer(c_int) :: rank + integer(c_int),target,dimension(..) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(..) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + real(c_float),target,dimension(..) :: out + integer(c_int),target,dimension(..) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftwf_plan_many_dft_c2r_assumed_rank = fftwf_plan_many_dft_c2r_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,c_loc(out),c_loc(onembed),ostride,odist,flags) + end function + +#else + function fftwf_plan_many_dft_c2r_rank_0(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_c2r_rank_0 + integer(c_int) :: rank + integer(c_int),target :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + real(c_float),target :: out + integer(c_int),target :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftwf_plan_many_dft_c2r_rank_0 = fftwf_plan_many_dft_c2r_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,c_loc(out),c_loc(onembed),ostride,odist,flags) + end function + + function fftwf_plan_many_dft_c2r_rank_1(rank,n,howmany,in,inembed,istride,idist,out,onembed, & + ostride,odist,flags) + implicit none + type(c_ptr) :: fftwf_plan_many_dft_c2r_rank_1 + integer(c_int) :: rank + integer(c_int),target,dimension(:) :: n + integer(c_int) :: howmany + type(c_ptr), value :: in + integer(c_int),target,dimension(:) :: inembed + integer(c_int) :: istride + integer(c_int) :: idist + real(c_float),target,dimension(:) :: out + integer(c_int),target,dimension(:) :: onembed + integer(c_int) :: ostride + integer(c_int) :: odist + integer(c_int) :: flags + ! + fftwf_plan_many_dft_c2r_rank_1 = fftwf_plan_many_dft_c2r_(rank,c_loc(n),howmany,in, & + c_loc(inembed),istride,idist,c_loc(out),c_loc(onembed),ostride,odist,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_guru_dft_r2c_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru_dft_r2c_assumed_rank + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_guru_dft_r2c_assumed_rank = fftw_plan_guru_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#else + function fftw_plan_guru_dft_r2c_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru_dft_r2c_rank_0 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + real(c_double),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_guru_dft_r2c_rank_0 = fftw_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims, & + c_loc(in),out,flags) + end function + + function fftw_plan_guru_dft_r2c_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru_dft_r2c_rank_1 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_guru_dft_r2c_rank_1 = fftw_plan_guru_dft_r2c_(rank,dims,howmany_rank,howmany_dims, & + c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_guru_dft_r2c_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_r2c_assumed_rank + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_guru_dft_r2c_assumed_rank = fftwf_plan_guru_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#else + function fftwf_plan_guru_dft_r2c_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_r2c_rank_0 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + real(c_float),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_guru_dft_r2c_rank_0 = fftwf_plan_guru_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + + function fftwf_plan_guru_dft_r2c_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_r2c_rank_1 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_guru_dft_r2c_rank_1 = fftwf_plan_guru_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_guru_dft_c2r_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru_dft_c2r_assumed_rank + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftw_plan_guru_dft_c2r_assumed_rank = fftw_plan_guru_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#else + function fftw_plan_guru_dft_c2r_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru_dft_c2r_rank_0 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_double),target :: out + integer(c_int) :: flags + ! + fftw_plan_guru_dft_c2r_rank_0 = fftw_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims, & + in,c_loc(out),flags) + end function + + function fftw_plan_guru_dft_c2r_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru_dft_c2r_rank_1 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftw_plan_guru_dft_c2r_rank_1 = fftw_plan_guru_dft_c2r_(rank,dims,howmany_rank,howmany_dims, & + in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_guru_dft_c2r_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_c2r_assumed_rank + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftwf_plan_guru_dft_c2r_assumed_rank = fftwf_plan_guru_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#else + function fftwf_plan_guru_dft_c2r_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_c2r_rank_0 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_float),target :: out + integer(c_int) :: flags + ! + fftwf_plan_guru_dft_c2r_rank_0 = fftwf_plan_guru_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + + function fftwf_plan_guru_dft_c2r_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru_dft_c2r_rank_1 + integer(c_int) :: rank + type(fftw_iodim) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftwf_plan_guru_dft_c2r_rank_1 = fftwf_plan_guru_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_guru64_dft_r2c_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_r2c_assumed_rank + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_guru64_dft_r2c_assumed_rank = fftw_plan_guru64_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#else + function fftw_plan_guru64_dft_r2c_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_r2c_rank_0 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + real(c_double),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_guru64_dft_r2c_rank_0 = fftw_plan_guru64_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + + function fftw_plan_guru64_dft_r2c_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_r2c_rank_1 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftw_plan_guru64_dft_r2c_rank_1 = fftw_plan_guru64_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_guru64_dft_r2c_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out, & + flags) + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_r2c_assumed_rank + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_guru64_dft_r2c_assumed_rank = fftwf_plan_guru64_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#else + function fftwf_plan_guru64_dft_r2c_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_r2c_rank_0 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + real(c_float),target :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_guru64_dft_r2c_rank_0 = fftwf_plan_guru64_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + + function fftwf_plan_guru64_dft_r2c_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_r2c_rank_1 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + integer(c_int) :: flags + ! + fftwf_plan_guru64_dft_r2c_rank_1 = fftwf_plan_guru64_dft_r2c_(rank,dims,howmany_rank, & + howmany_dims,c_loc(in),out,flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftw_plan_guru64_dft_c2r_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_c2r_assumed_rank + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftw_plan_guru64_dft_c2r_assumed_rank = fftw_plan_guru64_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#else + function fftw_plan_guru64_dft_c2r_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_c2r_rank_0 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_double),target :: out + integer(c_int) :: flags + ! + fftw_plan_guru64_dft_c2r_rank_0 = fftw_plan_guru64_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + + function fftw_plan_guru64_dft_c2r_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftw_plan_guru64_dft_c2r_rank_1 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftw_plan_guru64_dft_c2r_rank_1 = fftw_plan_guru64_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function fftwf_plan_guru64_dft_c2r_assumed_rank(rank,dims,howmany_rank,howmany_dims,in,out, & + flags) + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_c2r_assumed_rank + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + integer(c_int) :: flags + ! + fftwf_plan_guru64_dft_c2r_assumed_rank = fftwf_plan_guru64_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#else + function fftwf_plan_guru64_dft_c2r_rank_0(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_c2r_rank_0 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_float),target :: out + integer(c_int) :: flags + ! + fftwf_plan_guru64_dft_c2r_rank_0 = fftwf_plan_guru64_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + + function fftwf_plan_guru64_dft_c2r_rank_1(rank,dims,howmany_rank,howmany_dims,in,out,flags) + implicit none + type(c_ptr) :: fftwf_plan_guru64_dft_c2r_rank_1 + integer(c_int) :: rank + type(fftw_iodim64) :: dims(*) + integer(c_int) :: howmany_rank + type(fftw_iodim64) :: howmany_dims(*) + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + integer(c_int) :: flags + ! + fftwf_plan_guru64_dft_c2r_rank_1 = fftwf_plan_guru64_dft_c2r_(rank,dims,howmany_rank, & + howmany_dims,in,c_loc(out),flags) + end function + +#endif +#ifdef USE_ASSUMED_RANK + subroutine fftw_execute_dft_r2c_assumed_rank(plan,in,out) + implicit none + type(c_ptr), value :: plan + real(c_double),target,dimension(..) :: in + type(c_ptr), value :: out + ! + call fftw_execute_dft_r2c_(plan,c_loc(in),out) + end subroutine + +#else + subroutine fftw_execute_dft_r2c_rank_0(plan,in,out) + implicit none + type(c_ptr), value :: plan + real(c_double),target :: in + type(c_ptr), value :: out + ! + call fftw_execute_dft_r2c_(plan,c_loc(in),out) + end subroutine + + subroutine fftw_execute_dft_r2c_rank_1(plan,in,out) + implicit none + type(c_ptr), value :: plan + real(c_double),target,dimension(:) :: in + type(c_ptr), value :: out + ! + call fftw_execute_dft_r2c_(plan,c_loc(in),out) + end subroutine + +#endif +#ifdef USE_ASSUMED_RANK + subroutine fftwf_execute_dft_r2c_assumed_rank(plan,in,out) + implicit none + type(c_ptr), value :: plan + real(c_float),target,dimension(..) :: in + type(c_ptr), value :: out + ! + call fftwf_execute_dft_r2c_(plan,c_loc(in),out) + end subroutine + +#else + subroutine fftwf_execute_dft_r2c_rank_0(plan,in,out) + implicit none + type(c_ptr), value :: plan + real(c_float),target :: in + type(c_ptr), value :: out + ! + call fftwf_execute_dft_r2c_(plan,c_loc(in),out) + end subroutine + + subroutine fftwf_execute_dft_r2c_rank_1(plan,in,out) + implicit none + type(c_ptr), value :: plan + real(c_float),target,dimension(:) :: in + type(c_ptr), value :: out + ! + call fftwf_execute_dft_r2c_(plan,c_loc(in),out) + end subroutine + +#endif +#ifdef USE_ASSUMED_RANK + subroutine fftw_execute_dft_c2r_assumed_rank(plan,in,out) + implicit none + type(c_ptr), value :: plan + type(c_ptr), value :: in + real(c_double),target,dimension(..) :: out + ! + call fftw_execute_dft_c2r_(plan,in,c_loc(out)) + end subroutine + +#else + subroutine fftw_execute_dft_c2r_rank_0(plan,in,out) + implicit none + type(c_ptr), value :: plan + type(c_ptr), value :: in + real(c_double),target :: out + ! + call fftw_execute_dft_c2r_(plan,in,c_loc(out)) + end subroutine + + subroutine fftw_execute_dft_c2r_rank_1(plan,in,out) + implicit none + type(c_ptr), value :: plan + type(c_ptr), value :: in + real(c_double),target,dimension(:) :: out + ! + call fftw_execute_dft_c2r_(plan,in,c_loc(out)) + end subroutine + +#endif +#ifdef USE_ASSUMED_RANK + subroutine fftwf_execute_dft_c2r_assumed_rank(plan,in,out) + implicit none + type(c_ptr), value :: plan + type(c_ptr), value :: in + real(c_float),target,dimension(..) :: out + ! + call fftwf_execute_dft_c2r_(plan,in,c_loc(out)) + end subroutine + +#else + subroutine fftwf_execute_dft_c2r_rank_0(plan,in,out) + implicit none + type(c_ptr), value :: plan + type(c_ptr), value :: in + real(c_float),target :: out + ! + call fftwf_execute_dft_c2r_(plan,in,c_loc(out)) + end subroutine + + subroutine fftwf_execute_dft_c2r_rank_1(plan,in,out) + implicit none + type(c_ptr), value :: plan + type(c_ptr), value :: in + real(c_float),target,dimension(:) :: out + ! + call fftwf_execute_dft_c2r_(plan,in,c_loc(out)) + end subroutine + +#endif +#ifdef USE_ASSUMED_RANK + subroutine fftw_flops_assumed_rank(arg1,arg2,arg3,arg4) + implicit none + type(c_ptr), value :: arg1 + real(c_double),target,dimension(..) :: arg2 + real(c_double),target,dimension(..) :: arg3 + real(c_double),target,dimension(..) :: arg4 + ! + call fftw_flops_(arg1,c_loc(arg2),c_loc(arg3),c_loc(arg4)) + end subroutine + +#else + subroutine fftw_flops_rank_0(arg1,arg2,arg3,arg4) + implicit none + type(c_ptr), value :: arg1 + real(c_double),target :: arg2 + real(c_double),target :: arg3 + real(c_double),target :: arg4 + ! + call fftw_flops_(arg1,c_loc(arg2),c_loc(arg3),c_loc(arg4)) + end subroutine + + subroutine fftw_flops_rank_1(arg1,arg2,arg3,arg4) + implicit none + type(c_ptr), value :: arg1 + real(c_double),target,dimension(:) :: arg2 + real(c_double),target,dimension(:) :: arg3 + real(c_double),target,dimension(:) :: arg4 + ! + call fftw_flops_(arg1,c_loc(arg2),c_loc(arg3),c_loc(arg4)) + end subroutine + +#endif +#ifdef USE_ASSUMED_RANK + subroutine fftwf_flops_assumed_rank(arg1,arg2,arg3,arg4) + implicit none + type(c_ptr), value :: arg1 + real(c_double),target,dimension(..) :: arg2 + real(c_double),target,dimension(..) :: arg3 + real(c_double),target,dimension(..) :: arg4 + ! + call fftwf_flops_(arg1,c_loc(arg2),c_loc(arg3),c_loc(arg4)) + end subroutine + +#else + subroutine fftwf_flops_rank_0(arg1,arg2,arg3,arg4) + implicit none + type(c_ptr), value :: arg1 + real(c_double),target :: arg2 + real(c_double),target :: arg3 + real(c_double),target :: arg4 + ! + call fftwf_flops_(arg1,c_loc(arg2),c_loc(arg3),c_loc(arg4)) + end subroutine + + subroutine fftwf_flops_rank_1(arg1,arg2,arg3,arg4) + implicit none + type(c_ptr), value :: arg1 + real(c_double),target,dimension(:) :: arg2 + real(c_double),target,dimension(:) :: arg3 + real(c_double),target,dimension(:) :: arg4 + ! + call fftwf_flops_(arg1,c_loc(arg2),c_loc(arg3),c_loc(arg4)) + end subroutine + +#endif +#endif end module hipfftw diff --git a/bindings/fortran/hipfft/metadata/hipfft.toml b/bindings/fortran/hipfft/metadata/hipfft.toml new file mode 100644 index 000000000000..195d31f6640f --- /dev/null +++ b/bindings/fortran/hipfft/metadata/hipfft.toml @@ -0,0 +1,101 @@ +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# SPDX-License-Identifier: MIT +# +# What the hipfft C headers cannot express, beyond the defaults the generator +# derives from them: one table per C function, and a key with braces names +# several. A _64 or _spt variant without a table takes its base's. See "Fixing a +# binding" in the generator README; `gen.sh --explain ` shows what +# applies. + +format = 1 +# scalar-host: +# workSize of the plan and size routines stays a scalar, which is right for a plan on +# one GPU. On a plan spread over several GPUs (hipfftXtSetGPUs), hipFFT writes one +# work size per GPU: such a caller passes c_loc of an array to the bind(C) form. + +[hipfftEstimate1d] +workSize = "scalar-host" + +[hipfftEstimate2d] +workSize = "scalar-host" + +[hipfftEstimate3d] +workSize = "scalar-host" + +[hipfftEstimateMany] +workSize = "scalar-host" + +[hipfftExecC2C] +idata = "any-rank" +odata = "any-rank" + +[hipfftExecC2R] +idata = "any-rank" +odata = "any-rank" + +[hipfftExecD2Z] +idata = "any-rank" +odata = "any-rank" + +[hipfftExecR2C] +idata = "any-rank" +odata = "any-rank" + +[hipfftExecZ2D] +idata = "any-rank" +odata = "any-rank" + +[hipfftExecZ2Z] +idata = "any-rank" +odata = "any-rank" + +[hipfftGetProperty] +value = "scalar-host" + +[hipfftGetSize1d] +workSize = "scalar-host" + +[hipfftGetSize2d] +workSize = "scalar-host" + +[hipfftGetSize3d] +workSize = "scalar-host" + +[hipfftGetSizeMany] +workSize = "scalar-host" + +[hipfftGetSizeMany64] +workSize = "scalar-host" + +[hipfftMakePlan1d] +workSize = "scalar-host" + +[hipfftMakePlan2d] +workSize = "scalar-host" + +[hipfftMakePlan3d] +workSize = "scalar-host" + +[hipfftMakePlanMany] +workSize = "scalar-host" + +[hipfftMakePlanMany64] +workSize = "scalar-host" + +[hipfftXtGetSizeMany] +workSize = "scalar-host" + +[hipfftXtMakePlanMany] +workSize = "scalar-host" + +# hipfftMp.h's routines exist only in a hipFFT built with HIPFFT_MPI_ENABLE, which the +# ROCm packages are not: a wrapper that calls one leaves an undefined symbol in a +# shared libhipfort (hipfort's shared-link test). These arrays stay type(c_ptr), so +# the routine keeps its bind(C) interface alone, which costs nothing until called. +[hipfftXtSetDistribution] +input_lower = "always-c-ptr" +input_upper = "always-c-ptr" +output_lower = "always-c-ptr" +output_upper = "always-c-ptr" +input_stride = "always-c-ptr" +output_stride = "always-c-ptr" diff --git a/bindings/fortran/hipfft/metadata/hipfftw.toml b/bindings/fortran/hipfft/metadata/hipfftw.toml new file mode 100644 index 000000000000..7ccdefdf5158 --- /dev/null +++ b/bindings/fortran/hipfft/metadata/hipfftw.toml @@ -0,0 +1,61 @@ +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# SPDX-License-Identifier: MIT +# +# What the hipfftw C headers cannot express, beyond the defaults the generator +# derives from them: one table per C function, and a key with braces names +# several. A _64 or _spt variant without a table takes its base's. See "Fixing a +# binding" in the generator README; `gen.sh --explain ` shows what +# applies. + +format = 1 +# struct-array: +# Pointers to an emitted derived type that are arrays, declared `type(T) :: x(*)`: +# the guru interface's dims (length rank) and howmany_dims (length howmany_rank). + +[fftw_plan_guru64_dft] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftw_plan_guru64_dft_c2r] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftw_plan_guru64_dft_r2c] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftw_plan_guru_dft] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftw_plan_guru_dft_c2r] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftw_plan_guru_dft_r2c] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftwf_plan_guru64_dft] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftwf_plan_guru64_dft_c2r] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftwf_plan_guru64_dft_r2c] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftwf_plan_guru_dft] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftwf_plan_guru_dft_c2r] +dims = "struct-array" +howmany_dims = "struct-array" + +[fftwf_plan_guru_dft_r2c] +dims = "struct-array" +howmany_dims = "struct-array" From 27beb1ad9f270860fe7922bcfbde0c8147f2846e Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Tue, 3 Nov 2026 21:32:05 -0600 Subject: [PATCH 05/12] feat(hipfft): install the Fortran binding tests Install the test executables in bin/, and a CTestTestfile.cmake in bin/hipfft-fortran/ with the same tests and properties as the build tree, so that ctest --test-dir runs them from an install, as TheRock's test jobs do for the libraries. --- bindings/fortran/hipfft/test/CMakeLists.txt | 26 +++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/bindings/fortran/hipfft/test/CMakeLists.txt b/bindings/fortran/hipfft/test/CMakeLists.txt index 85a2094db649..3bb863217c50 100644 --- a/bindings/fortran/hipfft/test/CMakeLists.txt +++ b/bindings/fortran/hipfft/test/CMakeLists.txt @@ -180,3 +180,29 @@ else() endforeach() endif() endif() + +# Installed tests: the executables go to bin/, and a CTestTestfile.cmake with +# the same tests and properties to bin/hipfft-fortran/, for ctest --test-dir. +include(GNUInstallDirs) +get_property(_hipfft_fortran_tests DIRECTORY PROPERTY TESTS) +if(_hipfft_fortran_tests) + set(_ctest "${CMAKE_CURRENT_BINARY_DIR}/install-CTestTestfile.cmake") + file(WRITE "${_ctest}" "") + foreach(_test IN LISTS _hipfft_fortran_tests) + string(REPLACE "_fortran_" "_fortran_test_" _target "${_test}") + install(TARGETS ${_target} RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}" COMPONENT tests) + file(APPEND "${_ctest}" "add_test(${_test} \"../${_target}\")\n") + foreach(_prop LABELS SKIP_RETURN_CODE ENVIRONMENT PASS_REGULAR_EXPRESSION FAIL_REGULAR_EXPRESSION) + get_test_property(${_test} ${_prop} _value) + if(_value) + file(APPEND "${_ctest}" "set_tests_properties(${_test} PROPERTIES ${_prop} [=[${_value}]=])\n") + endif() + endforeach() + endforeach() + install( + FILES "${_ctest}" + DESTINATION "${CMAKE_INSTALL_BINDIR}/hipfft-fortran" + COMPONENT tests + RENAME CTestTestfile.cmake + ) +endif() From f7e3777e2927853cb1b3b27a1449f8f71a4b41fc Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Tue, 3 Nov 2026 23:39:43 -0600 Subject: [PATCH 06/12] refactor(hipfft): build the Fortran binding standalone only The binding is built against an installed hipFFT and is never added to the library's build, so drop what only served that: the per-library BUILD_FORTRAN_* overrides, the PARENT_SCOPE results, the ROCM_HAVE_FORTRAN shortcut, the gating on the library's client and test options, and the comments about the root. Find the Fortran compiler through the cmake/ROCmFortranCompiler.cmake shared by all the bindings, and require CMake 3.19. The binding targets the ROCm backend only, so BUILD_FORTRAN_BINDINGS no longer defaults to OFF on the CUDA backend. Without the HIPFFT_* and HIPFFTW_* overrides, both modules build together. --- bindings/fortran/hipfft/CHANGELOG.md | 7 +- bindings/fortran/hipfft/CMakeLists.txt | 455 ++++++------------ .../hipfft/cmake/ROCmFortranCompiler.cmake | 59 +++ bindings/fortran/hipfft/test/CMakeLists.txt | 29 +- 4 files changed, 215 insertions(+), 335 deletions(-) create mode 100644 bindings/fortran/hipfft/cmake/ROCmFortranCompiler.cmake diff --git a/bindings/fortran/hipfft/CHANGELOG.md b/bindings/fortran/hipfft/CHANGELOG.md index 71eb1229d293..3651c28a284a 100644 --- a/bindings/fortran/hipfft/CHANGELOG.md +++ b/bindings/fortran/hipfft/CHANGELOG.md @@ -7,10 +7,9 @@ * Generated Fortran bindings, as two independent modules: `use hipfft` and link `hip::hipfft_fortran` for the hipFFT API, or `use hipfftw` and link `hip::hipfftw_fortran` for the FFTW compatibility API. - Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows and on the CUDA - backend), `BUILD_FORTRAN_CLIENTS` and `FORTRAN_ARRAY_INTERFACES` (`assumed-shape` by - default; `none` or `assumed-rank`); the `HIPFFT_*` and `HIPFFTW_*` spellings of the first two - switch either half on its own. Found with `find_package(hipfft-fortran)` and + Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows), + `BUILD_FORTRAN_CLIENTS` and `FORTRAN_ARRAY_INTERFACES` (`assumed-shape` by default; `none` or + `assumed-rank`). Found with `find_package(hipfft-fortran)` and `find_package(hipfftw-fortran)`; the archives and the `.mod` files install per compiler, under `/fortran/` and `/fortran/`. The archive has one section per procedure: link with `-Wl,--gc-sections` to keep only the wrappers diff --git a/bindings/fortran/hipfft/CMakeLists.txt b/bindings/fortran/hipfft/CMakeLists.txt index dc6eb77414d1..ede3df701209 100644 --- a/bindings/fortran/hipfft/CMakeLists.txt +++ b/bindings/fortran/hipfft/CMakeLists.txt @@ -26,145 +26,25 @@ # GENERATED by the rocm-fortran generator: regenerate them, do not edit them. # The two modules are independent (hipfftw.F90 does not `use hipfft`). -# Matches the hipFFT root, which adds this directory unconditionally. 3.17 -# ignores Fortran_PREPROCESS (3.18) but still preprocesses the .F90 extension. -cmake_minimum_required(VERSION 3.18) +cmake_minimum_required(VERSION 3.19) -# LANGUAGES NONE: C is enabled only where a hip package lookup needs it. -if(CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) - project(hipfft-fortran LANGUAGES NONE) -endif() +project(hipfft-fortran LANGUAGES NONE) -# ROCm ships no Fortran compiler on Windows, hence "${UNIX}". OFF on CUDA: the -# generated sources are untested against cuFFT. -if(BUILD_WITH_LIB STREQUAL "CUDA") - set(_hipfft_fortran_default OFF) -else() - set(_hipfft_fortran_default "${UNIX}") -endif() -# The only option(BUILD_FORTRAN_BINDINGS) in hipFFT: the first option() call -# fixes the cache entry, so a second default elsewhere would be ignored. -option(BUILD_FORTRAN_BINDINGS "Build the hipFFT and hipFFTW Fortran bindings" - "${_hipfft_fortran_default}") -unset(_hipfft_fortran_default) - -option(BUILD_FORTRAN_CLIENTS "Build the hipFFT and hipFFTW Fortran clients and binding tests" ON) - -# Both options are shared monorepo-wide; HIPFFT_* and HIPFFTW_* override them -# per binding. -set(_hipfft_bindings ${BUILD_FORTRAN_BINDINGS}) -set(_hipfftw_bindings ${BUILD_FORTRAN_BINDINGS}) -set(_hipfft_tests ${BUILD_FORTRAN_CLIENTS}) -set(_hipfftw_tests ${BUILD_FORTRAN_CLIENTS}) -if(DEFINED HIPFFT_BUILD_FORTRAN_BINDINGS) - set(_hipfft_bindings ${HIPFFT_BUILD_FORTRAN_BINDINGS}) -endif() -if(DEFINED HIPFFTW_BUILD_FORTRAN_BINDINGS) - set(_hipfftw_bindings ${HIPFFTW_BUILD_FORTRAN_BINDINGS}) -endif() -if(DEFINED HIPFFT_BUILD_FORTRAN_CLIENTS) - set(_hipfft_tests ${HIPFFT_BUILD_FORTRAN_CLIENTS}) -endif() -if(DEFINED HIPFFTW_BUILD_FORTRAN_CLIENTS) - set(_hipfftw_tests ${HIPFFTW_BUILD_FORTRAN_CLIENTS}) -endif() +# Not ON: ROCm ships no Fortran compiler on Windows. +option(BUILD_FORTRAN_BINDINGS "Build the hipFFT and hipFFTW Fortran bindings" "${UNIX}") +option(BUILD_FORTRAN_CLIENTS "Build the hipFFT and hipFFTW Fortran binding tests" ON) -# Mutually exclusive tiers: assumed-rank REPLACES the per-rank overloads. set(FORTRAN_ARRAY_INTERFACES "assumed-shape" CACHE STRING "Array-argument overloads to expose: none, assumed-shape, or assumed-rank") set_property(CACHE FORTRAN_ARRAY_INTERFACES PROPERTY STRINGS none assumed-shape assumed-rank) -if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) - set(HIPFFT_HAVE_FORTRAN_BINDINGS FALSE PARENT_SCOPE) - set(HIPFFTW_HAVE_FORTRAN_BINDINGS FALSE PARENT_SCOPE) -endif() - -if(NOT _hipfft_bindings AND NOT _hipfftw_bindings) +if(NOT BUILD_FORTRAN_BINDINGS) return() endif() -# Only reached when requested by hand. The symbols resolve against libhipfft -# (nvidia_detail) and cuFFTW (hip::hipfftw is its alias); only testing is missing. -if(BUILD_WITH_LIB STREQUAL "CUDA") - message(WARNING - "hipFFT: the Fortran bindings were requested on the CUDA backend. " - "hipfft.F90 and hipfftw.F90 are generated from the ROCm code path and are " - "not tested against a cuFFT-backed libhipfft, which is why they are off by " - "default there.") -endif() - -# ROCM_LIBS_HAVE_FORTRAN is the root's current name; drop it once the root -# publishes ROCM_HAVE_FORTRAN. -if(DEFINED ROCM_HAVE_FORTRAN) - set(_have_fortran ${ROCM_HAVE_FORTRAN}) -elseif(DEFINED ROCM_LIBS_HAVE_FORTRAN) - set(_have_fortran ${ROCM_LIBS_HAVE_FORTRAN}) -else() - include(CheckLanguage) - - # rocm-cmake's ROCMChecks watches CMAKE_Fortran_COMPILER and fails under - # ROCM_ERROR_TOOLCHAIN_VAR=ON; silence both flags across the probe. - set(_rocm_warn_toolchain_var "${ROCM_WARN_TOOLCHAIN_VAR}") - set(_rocm_error_toolchain_var "${ROCM_ERROR_TOOLCHAIN_VAR}") - set(ROCM_WARN_TOOLCHAIN_VAR OFF) - set(ROCM_ERROR_TOOLCHAIN_VAR OFF) - - # Prefer ROCm's amdflang over the first compiler on PATH (often gfortran); - # an explicit CMAKE_Fortran_COMPILER or FC still wins. - if(NOT CMAKE_Fortran_COMPILER AND NOT DEFINED ENV{FC}) - set(_rocm_fc_hints) - foreach(_rocm_fc_cc "${CMAKE_CXX_COMPILER}" "${CMAKE_C_COMPILER}" - "${CMAKE_HIP_COMPILER}") - if(_rocm_fc_cc) - get_filename_component(_rocm_fc_dir "${_rocm_fc_cc}" DIRECTORY) - list(APPEND _rocm_fc_hints "${_rocm_fc_dir}") - endif() - endforeach() - foreach(_rocm_fc_root "${ROCM_PATH}" "$ENV{ROCM_PATH}" "/opt/rocm") - if(_rocm_fc_root) - list(APPEND _rocm_fc_hints "${_rocm_fc_root}/bin" - "${_rocm_fc_root}/lib/llvm/bin") - endif() - endforeach() - if(_rocm_fc_hints) - # Uncached, so a changed ROCM_PATH is honoured on reconfigure. - unset(_rocm_amdflang CACHE) - find_program(_rocm_amdflang NAMES amdflang HINTS ${_rocm_fc_hints} - NO_DEFAULT_PATH) - # A ROCm tree can carry a dangling amdflang symlink. - if(_rocm_amdflang) - execute_process(COMMAND "${_rocm_amdflang}" --version - RESULT_VARIABLE _rocm_fc_rc - OUTPUT_QUIET ERROR_QUIET) - if(_rocm_fc_rc EQUAL 0) - set(CMAKE_Fortran_COMPILER "${_rocm_amdflang}" CACHE FILEPATH - "Fortran compiler used for the ROCm Fortran bindings" FORCE) - endif() - unset(_rocm_fc_rc) - endif() - unset(_rocm_amdflang CACHE) - endif() - unset(_rocm_fc_hints) - unset(_rocm_fc_cc) - unset(_rocm_fc_dir) - unset(_rocm_fc_root) - endif() - - check_language(Fortran) - set(ROCM_WARN_TOOLCHAIN_VAR "${_rocm_warn_toolchain_var}") - set(ROCM_ERROR_TOOLCHAIN_VAR "${_rocm_error_toolchain_var}") - unset(_rocm_warn_toolchain_var) - unset(_rocm_error_toolchain_var) - - if(CMAKE_Fortran_COMPILER) - set(_have_fortran TRUE) - else() - set(_have_fortran FALSE) - endif() -endif() - -if(NOT _have_fortran) +include("${CMAKE_CURRENT_SOURCE_DIR}/cmake/ROCmFortranCompiler.cmake") +if(NOT CMAKE_Fortran_COMPILER) message(STATUS "hipFFT: no Fortran compiler found, skipping the Fortran bindings") return() endif() @@ -208,12 +88,8 @@ set(_moddir "${CMAKE_CURRENT_BINARY_DIR}/include") # Link interface only; one lookup defines hip::hipfft and hip::hipfftw. C is # enabled because hip-config-amd.cmake reaches FindThreads. -if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) - if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) - enable_language(C) - endif() - find_package(hipfft QUIET) -endif() +enable_language(C) +find_package(hipfft QUIET) if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) message(STATUS @@ -223,120 +99,89 @@ if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) "installed ROCm to have it recorded.") endif() -if(_hipfft_bindings) - add_library(hipfft_fortran STATIC hipfft.F90) - add_library(hip::hipfft_fortran ALIAS hipfft_fortran) - - # Each module compiles to one object, and a linker extracts whole objects from - # an archive, so a program that calls one wrapper links all of them. One section - # per procedure lets a program linked with -Wl,--gc-sections keep only the - # wrappers it calls, and still link when another wrapper names a C function the - # installed library does not export. Only these compilers split the sections - # (the Intel ones accept the flags but do not). - target_compile_options(hipfft_fortran PRIVATE - "$<$:-ffunction-sections;-fdata-sections>") - - set_target_properties(hipfft_fortran PROPERTIES - Fortran_MODULE_DIRECTORY "${_moddir}" - Fortran_PREPROCESS ON - Fortran_FORMAT FREE - POSITION_INDEPENDENT_CODE ON) - - if(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-shape") - target_compile_definitions(hipfft_fortran PRIVATE USE_ASSUMED_SHAPE=1) - elseif(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-rank") - target_compile_definitions(hipfft_fortran PRIVATE USE_ASSUMED_RANK=1) - endif() - - target_include_directories(hipfft_fortran PUBLIC - "$" - "$") +add_library(hipfft_fortran STATIC hipfft.F90) +add_library(hip::hipfft_fortran ALIAS hipfft_fortran) + +# Each module compiles to one object, and a linker extracts whole objects from +# an archive, so a program that calls one wrapper links all of them. One section +# per procedure lets a program linked with -Wl,--gc-sections keep only the +# wrappers it calls, and still link when another wrapper names a C function the +# installed library does not export. Only these compilers split the sections +# (the Intel ones accept the flags but do not). +target_compile_options(hipfft_fortran PRIVATE + "$<$:-ffunction-sections;-fdata-sections>") + +set_target_properties(hipfft_fortran PROPERTIES + Fortran_MODULE_DIRECTORY "${_moddir}" + Fortran_PREPROCESS ON + Fortran_FORMAT FREE + POSITION_INDEPENDENT_CODE ON) + +if(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-shape") + target_compile_definitions(hipfft_fortran PRIVATE USE_ASSUMED_SHAPE=1) +elseif(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-rank") + target_compile_definitions(hipfft_fortran PRIVATE USE_ASSUMED_RANK=1) +endif() - # Always TRUE or FALSE: the config template substitutes it into an if(). - if(TARGET hip::hipfft) - target_link_libraries(hipfft_fortran INTERFACE hip::hipfft) - set(HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE TRUE) - else() - set(HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE FALSE) - endif() +target_include_directories(hipfft_fortran PUBLIC + "$" + "$") - if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) - set(HIPFFT_HAVE_FORTRAN_BINDINGS TRUE PARENT_SCOPE) - endif() +# Always TRUE or FALSE: the config template substitutes it into an if(). +if(TARGET hip::hipfft) + target_link_libraries(hipfft_fortran INTERFACE hip::hipfft) + set(HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE TRUE) +else() + set(HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE FALSE) endif() -if(_hipfftw_bindings) - add_library(hipfftw_fortran STATIC hipfftw.F90) - add_library(hip::hipfftw_fortran ALIAS hipfftw_fortran) - - # Each module compiles to one object, and a linker extracts whole objects from - # an archive, so a program that calls one wrapper links all of them. One section - # per procedure lets a program linked with -Wl,--gc-sections keep only the - # wrappers it calls, and still link when another wrapper names a C function the - # installed library does not export. Only these compilers split the sections - # (the Intel ones accept the flags but do not). - target_compile_options(hipfftw_fortran PRIVATE - "$<$:-ffunction-sections;-fdata-sections>") - - # hipfftw.F90 has no guards today; kept so a regenerated one needs no change. - set_target_properties(hipfftw_fortran PROPERTIES - Fortran_MODULE_DIRECTORY "${_moddir}" - Fortran_PREPROCESS ON - Fortran_FORMAT FREE - POSITION_INDEPENDENT_CODE ON) - - if(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-shape") - target_compile_definitions(hipfftw_fortran PRIVATE USE_ASSUMED_SHAPE=1) - elseif(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-rank") - target_compile_definitions(hipfftw_fortran PRIVATE USE_ASSUMED_RANK=1) - endif() +add_library(hipfftw_fortran STATIC hipfftw.F90) +add_library(hip::hipfftw_fortran ALIAS hipfftw_fortran) - target_include_directories(hipfftw_fortran PUBLIC - "$" - "$") +# One section per procedure, as for hipfft_fortran. +target_compile_options(hipfftw_fortran PRIVATE + "$<$:-ffunction-sections;-fdata-sections>") - if(TARGET hip::hipfftw) - target_link_libraries(hipfftw_fortran INTERFACE hip::hipfftw) - set(HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE TRUE) - else() - set(HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE FALSE) - endif() +# hipfftw.F90 has no guards today; kept so a regenerated one needs no change. +set_target_properties(hipfftw_fortran PROPERTIES + Fortran_MODULE_DIRECTORY "${_moddir}" + Fortran_PREPROCESS ON + Fortran_FORMAT FREE + POSITION_INDEPENDENT_CODE ON) - if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) - set(HIPFFTW_HAVE_FORTRAN_BINDINGS TRUE PARENT_SCOPE) - endif() +if(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-shape") + target_compile_definitions(hipfftw_fortran PRIVATE USE_ASSUMED_SHAPE=1) +elseif(FORTRAN_ARRAY_INTERFACES STREQUAL "assumed-rank") + target_compile_definitions(hipfftw_fortran PRIVATE USE_ASSUMED_RANK=1) endif() -# In-tree the GPU tests follow hipFFT's client switches. BUILD_CLIENTS is read -# too: the root expands it into the other three only after this directory. -if(NOT CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR - AND (_hipfft_tests OR _hipfftw_tests) - AND NOT (BUILD_CLIENTS OR BUILD_CLIENTS_BENCH OR BUILD_CLIENTS_SAMPLES - OR BUILD_CLIENTS_TESTS)) - message(STATUS - "hipFFT: clients are not being built, skipping the Fortran binding tests.") - set(_hipfft_tests OFF) - set(_hipfftw_tests OFF) +target_include_directories(hipfftw_fortran PUBLIC + "$" + "$") + +if(TARGET hip::hipfftw) + target_link_libraries(hipfftw_fortran INTERFACE hip::hipfftw) + set(HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE TRUE) +else() + set(HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE FALSE) endif() # The uninstrumented Fortran executables cannot link an ASan libhipfft. -if((_hipfft_tests OR _hipfftw_tests) AND BUILD_ADDRESS_SANITIZER) +if(BUILD_FORTRAN_CLIENTS AND BUILD_ADDRESS_SANITIZER) message(STATUS "hipFFT: address sanitizer is enabled, skipping the Fortran binding tests.") - set(_hipfft_tests OFF) - set(_hipfftw_tests OFF) + set(BUILD_FORTRAN_CLIENTS OFF) endif() -if(_hipfft_tests OR _hipfftw_tests) - # In-tree the root enables testing on the same condition. +if(BUILD_FORTRAN_CLIENTS) enable_testing() add_subdirectory(test) endif() include(CMakePackageConfigHelpers) -# From this tree's root, not hipfft_VERSION, which standalone is the INSTALLED -# hipFFT. One version for both packages. +# Read from this tree, not hipfft_VERSION, which is the INSTALLED hipFFT's. One +# version for both packages. set(_fortran_version "") if(EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../../../projects/hipfft/CMakeLists.txt") file(READ "${CMAKE_CURRENT_SOURCE_DIR}/../../../projects/hipfft/CMakeLists.txt" _hipfft_root) @@ -375,102 +220,98 @@ set(HIPFFTW_FORTRAN_LIBDIR "${HIPFFT_FORTRAN_LIBDIR}") set(HIPFFTW_FORTRAN_INCLUDEDIR "${HIPFFT_FORTRAN_INCLUDEDIR}") # Two independent packages, both in lib/cmake/hipfft beside hipfft-config.cmake. -if(_hipfft_bindings) - install(TARGETS hipfft_fortran - EXPORT hipfft-fortran-targets - ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFT_FORTRAN_COMPILER_DIR}" - COMPONENT devel) - install(EXPORT hipfft-fortran-targets - FILE hipfft-fortran-targets.cmake - NAMESPACE hip:: - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - - # Under share/: the config reads every entry of include/fortran/ as a compiler. - install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfft.F90" - DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" - COMPONENT devel) - - configure_package_config_file( - "${CMAKE_CURRENT_SOURCE_DIR}/hipfft-fortran-config.cmake.in" - "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" - INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - PATH_VARS HIPFFT_FORTRAN_LIBDIR HIPFFT_FORTRAN_INCLUDEDIR) - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - - # find_package(hipfft-fortran) searches lib/cmake/hipfft-fortran*. - file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" +install(TARGETS hipfft_fortran + EXPORT hipfft-fortran-targets + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFT_FORTRAN_COMPILER_DIR}" + COMPONENT devel) +install(EXPORT hipfft-fortran-targets + FILE hipfft-fortran-targets.cmake + NAMESPACE hip:: + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + +# Under share/: the config reads every entry of include/fortran/ as a compiler. +install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfft.F90" + DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" + COMPONENT devel) + +configure_package_config_file( + "${CMAKE_CURRENT_SOURCE_DIR}/hipfft-fortran-config.cmake.in" + "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" + INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + PATH_VARS HIPFFT_FORTRAN_LIBDIR HIPFFT_FORTRAN_INCLUDEDIR) +install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + +# find_package(hipfft-fortran) searches lib/cmake/hipfft-fortran*. +file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" "# Generated forwarder. The real config lives beside the hipFFT C package, in # lib/cmake/hipfft, so that one CMAKE_PREFIX_PATH entry finds both. # This file only exists so that find_package(hipfft-fortran) resolves to the # same place. include(\"\${CMAKE_CURRENT_LIST_DIR}/../hipfft/hipfft-fortran-config.cmake\") ") - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" - COMPONENT devel) - - if(_fortran_version) - write_basic_package_version_file( - "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" - VERSION "${_fortran_version}" - COMPATIBILITY SameMajorVersion) - # Beside both the config and the forwarder. - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" - COMPONENT devel) - endif() -endif() - -if(_hipfftw_bindings) - install(TARGETS hipfftw_fortran - EXPORT hipfftw-fortran-targets - ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFTW_FORTRAN_COMPILER_DIR}" - COMPONENT devel) - install(EXPORT hipfftw-fortran-targets - FILE hipfftw-fortran-targets.cmake - NAMESPACE hip:: +install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" + COMPONENT devel) + +if(_fortran_version) + write_basic_package_version_file( + "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" + VERSION "${_fortran_version}" + COMPATIBILITY SameMajorVersion) + # Beside both the config and the forwarder. + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" COMPONENT devel) - - install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw.F90" - DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" - COMPONENT devel) - - configure_package_config_file( - "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw-fortran-config.cmake.in" - "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" - INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - PATH_VARS HIPFFTW_FORTRAN_LIBDIR HIPFFTW_FORTRAN_INCLUDEDIR) - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" COMPONENT devel) +endif() - file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" +install(TARGETS hipfftw_fortran + EXPORT hipfftw-fortran-targets + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFTW_FORTRAN_COMPILER_DIR}" + COMPONENT devel) +install(EXPORT hipfftw-fortran-targets + FILE hipfftw-fortran-targets.cmake + NAMESPACE hip:: + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + +install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw.F90" + DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" + COMPONENT devel) + +configure_package_config_file( + "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw-fortran-config.cmake.in" + "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" + INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + PATH_VARS HIPFFTW_FORTRAN_LIBDIR HIPFFTW_FORTRAN_INCLUDEDIR) +install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + +file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" "# Generated forwarder. hipFFTW ships inside the hipFFT package, so the real # config lives in lib/cmake/hipfft beside hipfft-config.cmake. This file only # exists so that find_package(hipfftw-fortran) resolves to the same place. include(\"\${CMAKE_CURRENT_LIST_DIR}/../hipfft/hipfftw-fortran-config.cmake\") ") - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" +install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" + COMPONENT devel) + +if(_fortran_version) + write_basic_package_version_file( + "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" + VERSION "${_fortran_version}" + COMPATIBILITY SameMajorVersion) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + COMPONENT devel) + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" COMPONENT devel) - - if(_fortran_version) - write_basic_package_version_file( - "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" - VERSION "${_fortran_version}" - COMPATIBILITY SameMajorVersion) - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" - COMPONENT devel) - endif() endif() diff --git a/bindings/fortran/hipfft/cmake/ROCmFortranCompiler.cmake b/bindings/fortran/hipfft/cmake/ROCmFortranCompiler.cmake new file mode 100644 index 000000000000..616f4fa03c68 --- /dev/null +++ b/bindings/fortran/hipfft/cmake/ROCmFortranCompiler.cmake @@ -0,0 +1,59 @@ +# Copyright Advanced Micro Devices, Inc., or its affiliates. +# SPDX-License-Identifier: MIT + +# Runs check_language(Fortran), preferring ROCm's amdflang over the first +# Fortran compiler on PATH (often gfortran). An explicit CMAKE_Fortran_COMPILER +# or FC wins. CMAKE_Fortran_COMPILER is left false when none is found. + +include(CheckLanguage) + +# rocm-cmake's ROCMChecks watches CMAKE_Fortran_COMPILER and fails under +# ROCM_ERROR_TOOLCHAIN_VAR=ON; silence it across the writes. +set(_rocm_fc_warn_toolchain_var "${ROCM_WARN_TOOLCHAIN_VAR}") +set(_rocm_fc_error_toolchain_var "${ROCM_ERROR_TOOLCHAIN_VAR}") +set(ROCM_WARN_TOOLCHAIN_VAR OFF) +set(ROCM_ERROR_TOOLCHAIN_VAR OFF) + +if(NOT CMAKE_Fortran_COMPILER AND NOT DEFINED ENV{FC}) + set(_rocm_fc_hints) + foreach(_rocm_fc_cc "${CMAKE_CXX_COMPILER}" "${CMAKE_C_COMPILER}" + "${CMAKE_HIP_COMPILER}") + if(_rocm_fc_cc) + get_filename_component(_rocm_fc_dir "${_rocm_fc_cc}" DIRECTORY) + list(APPEND _rocm_fc_hints "${_rocm_fc_dir}") + endif() + endforeach() + foreach(_rocm_fc_root "${ROCM_PATH}" "$ENV{ROCM_PATH}" "/opt/rocm") + if(_rocm_fc_root) + list(APPEND _rocm_fc_hints "${_rocm_fc_root}/bin" + "${_rocm_fc_root}/lib/llvm/bin") + endif() + endforeach() + # Uncached, so a changed ROCM_PATH is honoured on reconfigure. + unset(_rocm_amdflang CACHE) + find_program(_rocm_amdflang NAMES amdflang HINTS ${_rocm_fc_hints} + NO_DEFAULT_PATH) + # A ROCm tree can carry a dangling amdflang symlink. + if(_rocm_amdflang) + execute_process(COMMAND "${_rocm_amdflang}" --version + RESULT_VARIABLE _rocm_fc_rc + OUTPUT_QUIET ERROR_QUIET) + if(_rocm_fc_rc EQUAL 0) + set(CMAKE_Fortran_COMPILER "${_rocm_amdflang}" CACHE FILEPATH + "Fortran compiler used for the ROCm Fortran bindings" FORCE) + endif() + endif() + unset(_rocm_amdflang CACHE) +endif() + +check_language(Fortran) + +set(ROCM_WARN_TOOLCHAIN_VAR "${_rocm_fc_warn_toolchain_var}") +set(ROCM_ERROR_TOOLCHAIN_VAR "${_rocm_fc_error_toolchain_var}") +unset(_rocm_fc_warn_toolchain_var) +unset(_rocm_fc_error_toolchain_var) +unset(_rocm_fc_hints) +unset(_rocm_fc_cc) +unset(_rocm_fc_dir) +unset(_rocm_fc_root) +unset(_rocm_fc_rc) diff --git a/bindings/fortran/hipfft/test/CMakeLists.txt b/bindings/fortran/hipfft/test/CMakeLists.txt index 3bb863217c50..952f2ea6e7b5 100644 --- a/bindings/fortran/hipfft/test/CMakeLists.txt +++ b/bindings/fortran/hipfft/test/CMakeLists.txt @@ -23,7 +23,7 @@ # ############################################################################ # hipFFT and hipFFTW Fortran binding tests: one GPU executable per test. Each -# half guards itself on its own binding target and C library. +# half guards itself on its C library. # ifx/ifort skip .f03/.f08 files unless -Tf precedes the source. if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") @@ -39,14 +39,6 @@ if(NOT APPLE AND NOT WIN32) add_link_options(-Wl,--gc-sections) endif() -# hip-config-amd.cmake reaches FindThreads, which needs C or CXX enabled. -if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) - if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) - enable_language(C) - endif() - find_package(hipfft QUIET) -endif() - # The tests `use hip`, so hip.mod (rocm-systems, same compiler) is required. if(NOT TARGET hip::hip_fortran) find_package(hip-fortran QUIET) @@ -58,16 +50,10 @@ if(NOT TARGET hip::hip_fortran) "this compiler to build them.") endif() -if(NOT _hipfft_tests) - # Deliberately silent: the parent was told not to build this half. -elseif(NOT TARGET hipfft_fortran) - message(STATUS - "hipFFT: the Fortran binding target was not built, skipping its tests.") -elseif(NOT TARGET hip::hipfft) +if(NOT TARGET hip::hipfft) message(STATUS "hipFFT: no hip::hipfft target, skipping the hipFFT Fortran binding tests " - "(they link libhipfft). Point CMAKE_PREFIX_PATH at an installed ROCm to " - "build them standalone.") + "(they link libhipfft). Point CMAKE_PREFIX_PATH at an installed ROCm.") else() # hipfft_fortran_add_test( [F2008]): F2008 builds .f08, which # exercises the array overloads, as test hipfft_fortran__f2008. @@ -133,16 +119,11 @@ else() endif() endif() -if(NOT _hipfftw_tests) - # Deliberately silent: the parent was told not to build this half. -elseif(NOT TARGET hipfftw_fortran) - message(STATUS - "hipFFTW: the Fortran binding target was not built, skipping its tests.") -elseif(NOT TARGET hip::hipfftw) +if(NOT TARGET hip::hipfftw) message(STATUS "hipFFTW: no hip::hipfftw target, skipping the hipFFTW Fortran binding " "tests (they link libhipfftw). Point CMAKE_PREFIX_PATH at an installed " - "ROCm to build them standalone.") + "ROCm.") else() # hipfftw_fortran_add_test(): builds .f03 as test # hipfftw_fortran_. From 7815353cec9230e8c6d89fd3ccb43df2b2cf3f0d Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 7 Nov 2026 02:08:17 -0600 Subject: [PATCH 07/12] feat(hipfft): split the Fortran binding into the hipfft and hipfftxt modules One module per C header, as CUDA Fortran's cufft and cufftXt, so that `use cufftXt` hipifies to `use hipfftxt`: hipfft holds hipfft.h, and hipfftxt holds hipfftXt.h and hipfftMp.h. hipfftxt uses hipfft, so `use hipfftxt` alone gives the whole API. Both build into libhipfft_fortran.a (hip::hipfft_fortran), and the Xt and Mp metadata moves to metadata/hipfftxt.toml. Regenerated with ROCm/rocm-fortran-generator#17. --- bindings/fortran/hipfft/.gitattributes | 1 + bindings/fortran/hipfft/CHANGELOG.md | 8 +- bindings/fortran/hipfft/CMakeLists.txt | 11 +- bindings/fortran/hipfft/hipfft.F90 | 601 ---------------- bindings/fortran/hipfft/hipfftxt.F90 | 641 ++++++++++++++++++ bindings/fortran/hipfft/metadata/hipfft.toml | 18 - .../fortran/hipfft/metadata/hipfftxt.toml | 32 + .../hipfft/test/hipfft_xt_descriptor_z.f03 | 2 +- .../hipfft/test/hipfft_xt_makeplanmany_c.f03 | 2 +- 9 files changed, 688 insertions(+), 628 deletions(-) create mode 100644 bindings/fortran/hipfft/hipfftxt.F90 create mode 100644 bindings/fortran/hipfft/metadata/hipfftxt.toml diff --git a/bindings/fortran/hipfft/.gitattributes b/bindings/fortran/hipfft/.gitattributes index 54c974d9df6f..181c7cb190e8 100644 --- a/bindings/fortran/hipfft/.gitattributes +++ b/bindings/fortran/hipfft/.gitattributes @@ -1,3 +1,4 @@ # Generated by the rocm-fortran generator /hipfft.F90 linguist-generated=true +/hipfftxt.F90 linguist-generated=true /hipfftw.F90 linguist-generated=true diff --git a/bindings/fortran/hipfft/CHANGELOG.md b/bindings/fortran/hipfft/CHANGELOG.md index 3651c28a284a..64a16466e237 100644 --- a/bindings/fortran/hipfft/CHANGELOG.md +++ b/bindings/fortran/hipfft/CHANGELOG.md @@ -4,9 +4,11 @@ ### Added -* Generated Fortran bindings, as two independent modules: `use hipfft` and link - `hip::hipfft_fortran` for the hipFFT API, or `use hipfftw` and link `hip::hipfftw_fortran` for the - FFTW compatibility API. +* Generated Fortran bindings, one module per C header, as CUDA Fortran's `cufft` and `cufftXt`: + `use hipfft` (`hipfft.h`) or `use hipfftxt` (`hipfftXt.h` and `hipfftMp.h`; it uses and re-exports + `hipfft`, so it alone gives the whole API) and link `hip::hipfft_fortran`, or `use hipfftw` + (`hipfftw.h`) and link `hip::hipfftw_fortran` for the FFTW compatibility API. Fortran is + case-insensitive, so `use hipfftXt` works too. Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows), `BUILD_FORTRAN_CLIENTS` and `FORTRAN_ARRAY_INTERFACES` (`assumed-shape` by default; `none` or `assumed-rank`). Found with `find_package(hipfft-fortran)` and diff --git a/bindings/fortran/hipfft/CMakeLists.txt b/bindings/fortran/hipfft/CMakeLists.txt index ede3df701209..9a1619b6db33 100644 --- a/bindings/fortran/hipfft/CMakeLists.txt +++ b/bindings/fortran/hipfft/CMakeLists.txt @@ -22,9 +22,11 @@ # THE SOFTWARE. # ############################################################################ -# Fortran bindings for hipFFT and hipFFTW. hipfft.F90 and hipfftw.F90 are -# GENERATED by the rocm-fortran generator: regenerate them, do not edit them. -# The two modules are independent (hipfftw.F90 does not `use hipfft`). +# Fortran bindings for hipFFT and hipFFTW. hipfft.F90, hipfftxt.F90 and +# hipfftw.F90 are GENERATED by the rocm-fortran generator: regenerate them, do +# not edit them. One module per C header: hipfft (hipfft.h), hipfftxt +# (hipfftXt.h and hipfftMp.h; it uses and re-exports hipfft) and hipfftw +# (hipfftw.h, independent of the other two). cmake_minimum_required(VERSION 3.19) @@ -99,7 +101,7 @@ if(NOT TARGET hip::hipfft AND NOT TARGET hip::hipfftw) "installed ROCm to have it recorded.") endif() -add_library(hipfft_fortran STATIC hipfft.F90) +add_library(hipfft_fortran STATIC hipfft.F90 hipfftxt.F90) add_library(hip::hipfft_fortran ALIAS hipfft_fortran) # Each module compiles to one object, and a linker extracts whole objects from @@ -232,6 +234,7 @@ install(EXPORT hipfft-fortran-targets # Under share/: the config reads every entry of include/fortran/ as a compiler. install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfft.F90" + "${CMAKE_CURRENT_SOURCE_DIR}/hipfftxt.F90" DESTINATION "${CMAKE_INSTALL_DATADIR}/hipfft/fortran" COMPONENT devel) diff --git a/bindings/fortran/hipfft/hipfft.F90 b/bindings/fortran/hipfft/hipfft.F90 index 0fa8a09ec2e0..e96a52f23037 100644 --- a/bindings/fortran/hipfft/hipfft.F90 +++ b/bindings/fortran/hipfft/hipfft.F90 @@ -64,73 +64,11 @@ module hipfft enumerator :: HIPFFT_PATCH_LEVEL = 2 end enum - ! hiplibFormat_t - enum, bind(c) - enumerator :: HIPLIB_FORMAT_HIPFFT = 0 - enumerator :: HIPLIB_FORMAT_UNDEFINED = 1 - end enum - - ! hipfftXtCopyType_t - enum, bind(c) - enumerator :: HIPFFT_COPY_HOST_TO_DEVICE = 0 - enumerator :: HIPFFT_COPY_DEVICE_TO_HOST = 1 - enumerator :: HIPFFT_COPY_DEVICE_TO_DEVICE = 2 - enumerator :: HIPFFT_COPY_UNDEFINED = 3 - end enum - - ! hipfftXtCallbackType_t - enum, bind(c) - enumerator :: HIPFFT_CB_LD_COMPLEX = 0 - enumerator :: HIPFFT_CB_LD_COMPLEX_DOUBLE = 1 - enumerator :: HIPFFT_CB_LD_REAL = 2 - enumerator :: HIPFFT_CB_LD_REAL_DOUBLE = 3 - enumerator :: HIPFFT_CB_ST_COMPLEX = 4 - enumerator :: HIPFFT_CB_ST_COMPLEX_DOUBLE = 5 - enumerator :: HIPFFT_CB_ST_REAL = 6 - enumerator :: HIPFFT_CB_ST_REAL_DOUBLE = 7 - enumerator :: HIPFFT_CB_UNDEFINED = 8 - end enum - - ! hipfftXtSubFormat_t - enum, bind(c) - enumerator :: HIPFFT_XT_FORMAT_INPUT = 0 - enumerator :: HIPFFT_XT_FORMAT_OUTPUT = 1 - enumerator :: HIPFFT_XT_FORMAT_INPLACE = 2 - enumerator :: HIPFFT_XT_FORMAT_INPLACE_SHUFFLED = 3 - enumerator :: HIPFFT_XT_FORMAT_1D_INPUT_SHUFFLED = 4 - enumerator :: HIPFFT_FORMAT_UNDEFINED = 5 - end enum - - ! hipfftMpCommType_t - enum, bind(c) - enumerator :: HIPFFT_COMM_MPI = 0 - enumerator :: HIPFFT_COMM_NONE = 1 - end enum - integer(c_int), parameter :: hipfftVersionMajor = 1 integer(c_int), parameter :: hipfftVersionMinor = 0 integer(c_int), parameter :: hipfftVersionPatch = 27 integer(c_int), parameter :: HIPFFT_FORWARD = -1 integer(c_int), parameter :: HIPFFT_BACKWARD = 1 - integer(c_int), parameter :: MAX_HIP_DESCRIPTOR_GPUS = 64 - - - type, bind(c) :: hipXtDesc - integer(c_int) :: version - integer(c_int) :: nGPUs - integer(c_int) :: GPUs(64) - type(c_ptr) :: data(64) - integer(c_size_t) :: size(64) - type(c_ptr) :: hipXtState - end type hipXtDesc - - type, bind(c) :: hipLibXtDesc - integer(c_int) :: version - type(c_ptr) :: descriptor - integer(c_int) :: library - integer(c_int) :: subFormat - type(c_ptr) :: libDescriptor - end type hipLibXtDesc interface hipfftPlan1d @@ -747,318 +685,6 @@ function hipfftGetProperty_(myType,myValue) bind(c, name="hipfftGetProperty") module procedure hipfftGetProperty_typed end interface - interface hipfftXtSetCallback - function hipfftXtSetCallback_(plan,callbacks,cbtype,callbackData) & - bind(c, name="hipfftXtSetCallback") - import - implicit none - integer(c_int) :: hipfftXtSetCallback_ - type(c_ptr),value :: plan - type(c_ptr) :: callbacks - integer(c_int),value :: cbtype - type(c_ptr) :: callbackData - end function - end interface - - interface hipfftXtClearCallback - function hipfftXtClearCallback_(plan,cbtype) bind(c, name="hipfftXtClearCallback") - import - implicit none - integer(c_int) :: hipfftXtClearCallback_ - type(c_ptr),value :: plan - integer(c_int),value :: cbtype - end function - end interface - - interface hipfftXtSetCallbackSharedSize - function hipfftXtSetCallbackSharedSize_(plan,cbtype,sharedSize) & - bind(c, name="hipfftXtSetCallbackSharedSize") - import - implicit none - integer(c_int) :: hipfftXtSetCallbackSharedSize_ - type(c_ptr),value :: plan - integer(c_int),value :: cbtype - integer(c_size_t),value :: sharedSize - end function - end interface - - interface hipfftXtSetJITCallback - function hipfftXtSetJITCallback_(plan,symbol_name,bitcode_data,bitcode_len_bytes,cbtype, & - cbdata) & - bind(c, name="hipfftXtSetJITCallback") - import - implicit none - integer(c_int) :: hipfftXtSetJITCallback_ - type(c_ptr),value :: plan - type(c_ptr),value :: symbol_name - type(c_ptr),value :: bitcode_data - integer(c_size_t),value :: bitcode_len_bytes - integer(c_int),value :: cbtype - type(c_ptr) :: cbdata - end function - end interface - - interface hipfftXtMakePlanMany - function hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & - odist,outputType,batch,workSize,executionType) & - bind(c, name="hipfftXtMakePlanMany") - import - implicit none - integer(c_int) :: hipfftXtMakePlanMany_ - type(c_ptr),value :: plan - integer(c_int),value :: rank - type(c_ptr),value :: n - type(c_ptr),value :: inembed - integer(c_int64_t),value :: istride - integer(c_int64_t),value :: idist - integer(c_int),value :: inputType - type(c_ptr),value :: onembed - integer(c_int64_t),value :: ostride - integer(c_int64_t),value :: odist - integer(c_int),value :: outputType - integer(c_int64_t),value :: batch - type(c_ptr),value :: workSize - integer(c_int),value :: executionType - end function - - module procedure hipfftXtMakePlanMany_typed - -#ifdef USE_ASSUMED_RANK - module procedure hipfftXtMakePlanMany_assumed_rank -#else -#ifdef USE_ASSUMED_SHAPE - module procedure & - hipfftXtMakePlanMany_rank_0,& - hipfftXtMakePlanMany_rank_1 -#endif -#endif - end interface - - interface hipfftXtGetSizeMany - function hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & - odist,outputType,batch,workSize,executionType) & - bind(c, name="hipfftXtGetSizeMany") - import - implicit none - integer(c_int) :: hipfftXtGetSizeMany_ - type(c_ptr),value :: plan - integer(c_int),value :: rank - type(c_ptr),value :: n - type(c_ptr),value :: inembed - integer(c_int64_t),value :: istride - integer(c_int64_t),value :: idist - integer(c_int),value :: inputType - type(c_ptr),value :: onembed - integer(c_int64_t),value :: ostride - integer(c_int64_t),value :: odist - integer(c_int),value :: outputType - integer(c_int64_t),value :: batch - type(c_ptr),value :: workSize - integer(c_int),value :: executionType - end function - - module procedure hipfftXtGetSizeMany_typed - -#ifdef USE_ASSUMED_RANK - module procedure hipfftXtGetSizeMany_assumed_rank -#else -#ifdef USE_ASSUMED_SHAPE - module procedure & - hipfftXtGetSizeMany_rank_0,& - hipfftXtGetSizeMany_rank_1 -#endif -#endif - end interface - - interface hipfftXtExec - function hipfftXtExec_(plan,input,output,direction) bind(c, name="hipfftXtExec") - import - implicit none - integer(c_int) :: hipfftXtExec_ - type(c_ptr),value :: plan - type(c_ptr),value :: input - type(c_ptr),value :: output - integer(c_int),value :: direction - end function - end interface - - interface hipfftXtSetGPUs - function hipfftXtSetGPUs_(plan,count,gpus) bind(c, name="hipfftXtSetGPUs") - import - implicit none - integer(c_int) :: hipfftXtSetGPUs_ - type(c_ptr),value :: plan - integer(c_int),value :: count - type(c_ptr),value :: gpus - end function - -#ifdef USE_ASSUMED_RANK - module procedure hipfftXtSetGPUs_assumed_rank -#else -#ifdef USE_ASSUMED_SHAPE - module procedure & - hipfftXtSetGPUs_rank_0,& - hipfftXtSetGPUs_rank_1 -#endif -#endif - end interface - - interface hipfftXtMalloc - function hipfftXtMalloc_(plan,desc,myFormat) bind(c, name="hipfftXtMalloc") - import - implicit none - integer(c_int) :: hipfftXtMalloc_ - type(c_ptr),value :: plan - type(c_ptr) :: desc - integer(c_int),value :: myFormat - end function - end interface - - interface hipfftXtMemcpy - function hipfftXtMemcpy_(plan,dest,src,myType) bind(c, name="hipfftXtMemcpy") - import - implicit none - integer(c_int) :: hipfftXtMemcpy_ - type(c_ptr),value :: plan - type(c_ptr),value :: dest - type(c_ptr),value :: src - integer(c_int),value :: myType - end function - end interface - - interface hipfftXtFree - function hipfftXtFree_(desc) bind(c, name="hipfftXtFree") - import - implicit none - integer(c_int) :: hipfftXtFree_ - type(hipLibXtDesc) :: desc - end function - end interface - - interface hipfftXtExecDescriptorC2C - function hipfftXtExecDescriptorC2C_(plan,input,output,direction) & - bind(c, name="hipfftXtExecDescriptorC2C") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptorC2C_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - integer(c_int),value :: direction - end function - end interface - - interface hipfftXtExecDescriptorR2C - function hipfftXtExecDescriptorR2C_(plan,input,output) bind(c, name="hipfftXtExecDescriptorR2C") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptorR2C_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - end function - end interface - - interface hipfftXtExecDescriptorC2R - function hipfftXtExecDescriptorC2R_(plan,input,output) bind(c, name="hipfftXtExecDescriptorC2R") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptorC2R_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - end function - end interface - - interface hipfftXtExecDescriptorZ2Z - function hipfftXtExecDescriptorZ2Z_(plan,input,output,direction) & - bind(c, name="hipfftXtExecDescriptorZ2Z") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptorZ2Z_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - integer(c_int),value :: direction - end function - end interface - - interface hipfftXtExecDescriptorD2Z - function hipfftXtExecDescriptorD2Z_(plan,input,output) bind(c, name="hipfftXtExecDescriptorD2Z") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptorD2Z_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - end function - end interface - - interface hipfftXtExecDescriptorZ2D - function hipfftXtExecDescriptorZ2D_(plan,input,output) bind(c, name="hipfftXtExecDescriptorZ2D") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptorZ2D_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - end function - end interface - - interface hipfftXtExecDescriptor - function hipfftXtExecDescriptor_(plan,input,output,direction) & - bind(c, name="hipfftXtExecDescriptor") - import - implicit none - integer(c_int) :: hipfftXtExecDescriptor_ - type(c_ptr),value :: plan - type(hipLibXtDesc) :: input - type(hipLibXtDesc) :: output - integer(c_int),value :: direction - end function - end interface - - interface hipfftMpAttachComm - function hipfftMpAttachComm_(plan,comm_type,comm_handle) bind(c, name="hipfftMpAttachComm") - import - implicit none - integer(c_int) :: hipfftMpAttachComm_ - type(c_ptr),value :: plan - integer(c_int),value :: comm_type - type(c_ptr),value :: comm_handle - end function - end interface - - interface hipfftXtSetDistribution - function hipfftXtSetDistribution_(plan,rank,input_lower,input_upper,output_lower,output_upper, & - input_stride,output_stride) & - bind(c, name="hipfftXtSetDistribution") - import - implicit none - integer(c_int) :: hipfftXtSetDistribution_ - type(c_ptr),value :: plan - integer(c_int),value :: rank - type(c_ptr),value :: input_lower - type(c_ptr),value :: input_upper - type(c_ptr),value :: output_lower - type(c_ptr),value :: output_upper - type(c_ptr),value :: input_stride - type(c_ptr),value :: output_stride - end function - end interface - - interface hipfftXtSetSubformatDefault - function hipfftXtSetSubformatDefault_(plan,subformat_forward,subformat_inverse) & - bind(c, name="hipfftXtSetSubformatDefault") - import - implicit none - integer(c_int) :: hipfftXtSetSubformatDefault_ - type(c_ptr),value :: plan - integer(c_int),value :: subformat_forward - integer(c_int),value :: subformat_inverse - end function - end interface - contains @@ -1342,52 +968,6 @@ function hipfftGetProperty_typed(myType,myValue) hipfftGetProperty_typed = hipfftGetProperty_(myType,c_loc(myValue)) end function - function hipfftXtMakePlanMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_typed - type(c_ptr), value :: plan - integer(c_int) :: rank - type(c_ptr) :: n - type(c_ptr) :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - type(c_ptr) :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtMakePlanMany_typed = hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist, & - inputType,onembed,ostride,odist,outputType,batch,c_loc(workSize),executionType) - end function - - function hipfftXtGetSizeMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_typed - type(c_ptr), value :: plan - integer(c_int) :: rank - type(c_ptr) :: n - type(c_ptr) :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - type(c_ptr) :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtGetSizeMany_typed = hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist, & - inputType,onembed,ostride,odist,outputType,batch,c_loc(workSize),executionType) - end function - #if defined(USE_ASSUMED_SHAPE) || defined(USE_ASSUMED_RANK) @@ -2108,187 +1688,6 @@ function hipfftExecZ2D_rank_3(plan,idata,odata) hipfftExecZ2D_rank_3 = hipfftExecZ2D_(plan,c_loc(idata),c_loc(odata)) end function -#endif -#ifdef USE_ASSUMED_RANK - function hipfftXtMakePlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,inputType, & - onembed,ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_assumed_rank - type(c_ptr), value :: plan - integer(c_int) :: rank - integer(c_int64_t),target,dimension(..) :: n - integer(c_int64_t),target,dimension(..) :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - integer(c_int64_t),target,dimension(..) :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtMakePlanMany_assumed_rank = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & - istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & - executionType) - end function - -#else - function hipfftXtMakePlanMany_rank_0(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_rank_0 - type(c_ptr), value :: plan - integer(c_int) :: rank - integer(c_int64_t),target :: n - integer(c_int64_t),target :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - integer(c_int64_t),target :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtMakePlanMany_rank_0 = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & - istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & - executionType) - end function - - function hipfftXtMakePlanMany_rank_1(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_rank_1 - type(c_ptr), value :: plan - integer(c_int) :: rank - integer(c_int64_t),target,dimension(:) :: n - integer(c_int64_t),target,dimension(:) :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - integer(c_int64_t),target,dimension(:) :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtMakePlanMany_rank_1 = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & - istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & - executionType) - end function - -#endif -#ifdef USE_ASSUMED_RANK - function hipfftXtGetSizeMany_assumed_rank(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_assumed_rank - type(c_ptr), value :: plan - integer(c_int) :: rank - integer(c_int64_t),target,dimension(..) :: n - integer(c_int64_t),target,dimension(..) :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - integer(c_int64_t),target,dimension(..) :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtGetSizeMany_assumed_rank = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed), & - istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & - executionType) - end function - -#else - function hipfftXtGetSizeMany_rank_0(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_rank_0 - type(c_ptr), value :: plan - integer(c_int) :: rank - integer(c_int64_t),target :: n - integer(c_int64_t),target :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - integer(c_int64_t),target :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtGetSizeMany_rank_0 = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & - idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize),executionType) - end function - - function hipfftXtGetSizeMany_rank_1(plan,rank,n,inembed,istride,idist,inputType,onembed, & - ostride,odist,outputType,batch,workSize,executionType) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_rank_1 - type(c_ptr), value :: plan - integer(c_int) :: rank - integer(c_int64_t),target,dimension(:) :: n - integer(c_int64_t),target,dimension(:) :: inembed - integer(c_int64_t) :: istride - integer(c_int64_t) :: idist - integer(c_int) :: inputType - integer(c_int64_t),target,dimension(:) :: onembed - integer(c_int64_t) :: ostride - integer(c_int64_t) :: odist - integer(c_int) :: outputType - integer(c_int64_t) :: batch - integer(c_size_t),target :: workSize - integer(c_int) :: executionType - ! - hipfftXtGetSizeMany_rank_1 = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & - idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize),executionType) - end function - -#endif -#ifdef USE_ASSUMED_RANK - function hipfftXtSetGPUs_assumed_rank(plan,count,gpus) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_assumed_rank - type(c_ptr), value :: plan - integer(c_int) :: count - integer(c_int),target,dimension(..) :: gpus - ! - hipfftXtSetGPUs_assumed_rank = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) - end function - -#else - function hipfftXtSetGPUs_rank_0(plan,count,gpus) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_rank_0 - type(c_ptr), value :: plan - integer(c_int) :: count - integer(c_int),target :: gpus - ! - hipfftXtSetGPUs_rank_0 = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) - end function - - function hipfftXtSetGPUs_rank_1(plan,count,gpus) - implicit none - integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_rank_1 - type(c_ptr), value :: plan - integer(c_int) :: count - integer(c_int),target,dimension(:) :: gpus - ! - hipfftXtSetGPUs_rank_1 = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) - end function - #endif #endif end module hipfft diff --git a/bindings/fortran/hipfft/hipfftxt.F90 b/bindings/fortran/hipfft/hipfftxt.F90 new file mode 100644 index 000000000000..6f8e158642df --- /dev/null +++ b/bindings/fortran/hipfft/hipfftxt.F90 @@ -0,0 +1,641 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +! +! SPDX-License-Identifier: MIT +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module hipfftxt + use hipfft + use, intrinsic :: iso_c_binding + implicit none + + ! hiplibFormat_t + enum, bind(c) + enumerator :: HIPLIB_FORMAT_HIPFFT = 0 + enumerator :: HIPLIB_FORMAT_UNDEFINED = 1 + end enum + + ! hipfftXtCopyType_t + enum, bind(c) + enumerator :: HIPFFT_COPY_HOST_TO_DEVICE = 0 + enumerator :: HIPFFT_COPY_DEVICE_TO_HOST = 1 + enumerator :: HIPFFT_COPY_DEVICE_TO_DEVICE = 2 + enumerator :: HIPFFT_COPY_UNDEFINED = 3 + end enum + + ! hipfftXtCallbackType_t + enum, bind(c) + enumerator :: HIPFFT_CB_LD_COMPLEX = 0 + enumerator :: HIPFFT_CB_LD_COMPLEX_DOUBLE = 1 + enumerator :: HIPFFT_CB_LD_REAL = 2 + enumerator :: HIPFFT_CB_LD_REAL_DOUBLE = 3 + enumerator :: HIPFFT_CB_ST_COMPLEX = 4 + enumerator :: HIPFFT_CB_ST_COMPLEX_DOUBLE = 5 + enumerator :: HIPFFT_CB_ST_REAL = 6 + enumerator :: HIPFFT_CB_ST_REAL_DOUBLE = 7 + enumerator :: HIPFFT_CB_UNDEFINED = 8 + end enum + + ! hipfftXtSubFormat_t + enum, bind(c) + enumerator :: HIPFFT_XT_FORMAT_INPUT = 0 + enumerator :: HIPFFT_XT_FORMAT_OUTPUT = 1 + enumerator :: HIPFFT_XT_FORMAT_INPLACE = 2 + enumerator :: HIPFFT_XT_FORMAT_INPLACE_SHUFFLED = 3 + enumerator :: HIPFFT_XT_FORMAT_1D_INPUT_SHUFFLED = 4 + enumerator :: HIPFFT_FORMAT_UNDEFINED = 5 + end enum + + ! hipfftMpCommType_t + enum, bind(c) + enumerator :: HIPFFT_COMM_MPI = 0 + enumerator :: HIPFFT_COMM_NONE = 1 + end enum + + integer(c_int), parameter :: MAX_HIP_DESCRIPTOR_GPUS = 64 + + + type, bind(c) :: hipXtDesc + integer(c_int) :: version + integer(c_int) :: nGPUs + integer(c_int) :: GPUs(64) + type(c_ptr) :: data(64) + integer(c_size_t) :: size(64) + type(c_ptr) :: hipXtState + end type hipXtDesc + + type, bind(c) :: hipLibXtDesc + integer(c_int) :: version + type(c_ptr) :: descriptor + integer(c_int) :: library + integer(c_int) :: subFormat + type(c_ptr) :: libDescriptor + end type hipLibXtDesc + + + interface hipfftXtSetCallback + function hipfftXtSetCallback_(plan,callbacks,cbtype,callbackData) & + bind(c, name="hipfftXtSetCallback") + import + implicit none + integer(c_int) :: hipfftXtSetCallback_ + type(c_ptr),value :: plan + type(c_ptr) :: callbacks + integer(c_int),value :: cbtype + type(c_ptr) :: callbackData + end function + end interface + + interface hipfftXtClearCallback + function hipfftXtClearCallback_(plan,cbtype) bind(c, name="hipfftXtClearCallback") + import + implicit none + integer(c_int) :: hipfftXtClearCallback_ + type(c_ptr),value :: plan + integer(c_int),value :: cbtype + end function + end interface + + interface hipfftXtSetCallbackSharedSize + function hipfftXtSetCallbackSharedSize_(plan,cbtype,sharedSize) & + bind(c, name="hipfftXtSetCallbackSharedSize") + import + implicit none + integer(c_int) :: hipfftXtSetCallbackSharedSize_ + type(c_ptr),value :: plan + integer(c_int),value :: cbtype + integer(c_size_t),value :: sharedSize + end function + end interface + + interface hipfftXtSetJITCallback + function hipfftXtSetJITCallback_(plan,symbol_name,bitcode_data,bitcode_len_bytes,cbtype, & + cbdata) & + bind(c, name="hipfftXtSetJITCallback") + import + implicit none + integer(c_int) :: hipfftXtSetJITCallback_ + type(c_ptr),value :: plan + type(c_ptr),value :: symbol_name + type(c_ptr),value :: bitcode_data + integer(c_size_t),value :: bitcode_len_bytes + integer(c_int),value :: cbtype + type(c_ptr) :: cbdata + end function + end interface + + interface hipfftXtMakePlanMany + function hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & + odist,outputType,batch,workSize,executionType) & + bind(c, name="hipfftXtMakePlanMany") + import + implicit none + integer(c_int) :: hipfftXtMakePlanMany_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int64_t),value :: istride + integer(c_int64_t),value :: idist + integer(c_int),value :: inputType + type(c_ptr),value :: onembed + integer(c_int64_t),value :: ostride + integer(c_int64_t),value :: odist + integer(c_int),value :: outputType + integer(c_int64_t),value :: batch + type(c_ptr),value :: workSize + integer(c_int),value :: executionType + end function + + module procedure hipfftXtMakePlanMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftXtMakePlanMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftXtMakePlanMany_rank_0,& + hipfftXtMakePlanMany_rank_1 +#endif +#endif + end interface + + interface hipfftXtGetSizeMany + function hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist,inputType,onembed,ostride, & + odist,outputType,batch,workSize,executionType) & + bind(c, name="hipfftXtGetSizeMany") + import + implicit none + integer(c_int) :: hipfftXtGetSizeMany_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: n + type(c_ptr),value :: inembed + integer(c_int64_t),value :: istride + integer(c_int64_t),value :: idist + integer(c_int),value :: inputType + type(c_ptr),value :: onembed + integer(c_int64_t),value :: ostride + integer(c_int64_t),value :: odist + integer(c_int),value :: outputType + integer(c_int64_t),value :: batch + type(c_ptr),value :: workSize + integer(c_int),value :: executionType + end function + + module procedure hipfftXtGetSizeMany_typed + +#ifdef USE_ASSUMED_RANK + module procedure hipfftXtGetSizeMany_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftXtGetSizeMany_rank_0,& + hipfftXtGetSizeMany_rank_1 +#endif +#endif + end interface + + interface hipfftXtExec + function hipfftXtExec_(plan,input,output,direction) bind(c, name="hipfftXtExec") + import + implicit none + integer(c_int) :: hipfftXtExec_ + type(c_ptr),value :: plan + type(c_ptr),value :: input + type(c_ptr),value :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftXtSetGPUs + function hipfftXtSetGPUs_(plan,count,gpus) bind(c, name="hipfftXtSetGPUs") + import + implicit none + integer(c_int) :: hipfftXtSetGPUs_ + type(c_ptr),value :: plan + integer(c_int),value :: count + type(c_ptr),value :: gpus + end function + +#ifdef USE_ASSUMED_RANK + module procedure hipfftXtSetGPUs_assumed_rank +#else +#ifdef USE_ASSUMED_SHAPE + module procedure & + hipfftXtSetGPUs_rank_0,& + hipfftXtSetGPUs_rank_1 +#endif +#endif + end interface + + interface hipfftXtMalloc + function hipfftXtMalloc_(plan,desc,myFormat) bind(c, name="hipfftXtMalloc") + import + implicit none + integer(c_int) :: hipfftXtMalloc_ + type(c_ptr),value :: plan + type(c_ptr) :: desc + integer(c_int),value :: myFormat + end function + end interface + + interface hipfftXtMemcpy + function hipfftXtMemcpy_(plan,dest,src,myType) bind(c, name="hipfftXtMemcpy") + import + implicit none + integer(c_int) :: hipfftXtMemcpy_ + type(c_ptr),value :: plan + type(c_ptr),value :: dest + type(c_ptr),value :: src + integer(c_int),value :: myType + end function + end interface + + interface hipfftXtFree + function hipfftXtFree_(desc) bind(c, name="hipfftXtFree") + import + implicit none + integer(c_int) :: hipfftXtFree_ + type(hipLibXtDesc) :: desc + end function + end interface + + interface hipfftXtExecDescriptorC2C + function hipfftXtExecDescriptorC2C_(plan,input,output,direction) & + bind(c, name="hipfftXtExecDescriptorC2C") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorC2C_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftXtExecDescriptorR2C + function hipfftXtExecDescriptorR2C_(plan,input,output) bind(c, name="hipfftXtExecDescriptorR2C") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorR2C_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptorC2R + function hipfftXtExecDescriptorC2R_(plan,input,output) bind(c, name="hipfftXtExecDescriptorC2R") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorC2R_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptorZ2Z + function hipfftXtExecDescriptorZ2Z_(plan,input,output,direction) & + bind(c, name="hipfftXtExecDescriptorZ2Z") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorZ2Z_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftXtExecDescriptorD2Z + function hipfftXtExecDescriptorD2Z_(plan,input,output) bind(c, name="hipfftXtExecDescriptorD2Z") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorD2Z_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptorZ2D + function hipfftXtExecDescriptorZ2D_(plan,input,output) bind(c, name="hipfftXtExecDescriptorZ2D") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptorZ2D_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + end function + end interface + + interface hipfftXtExecDescriptor + function hipfftXtExecDescriptor_(plan,input,output,direction) & + bind(c, name="hipfftXtExecDescriptor") + import + implicit none + integer(c_int) :: hipfftXtExecDescriptor_ + type(c_ptr),value :: plan + type(hipLibXtDesc) :: input + type(hipLibXtDesc) :: output + integer(c_int),value :: direction + end function + end interface + + interface hipfftMpAttachComm + function hipfftMpAttachComm_(plan,comm_type,comm_handle) bind(c, name="hipfftMpAttachComm") + import + implicit none + integer(c_int) :: hipfftMpAttachComm_ + type(c_ptr),value :: plan + integer(c_int),value :: comm_type + type(c_ptr),value :: comm_handle + end function + end interface + + interface hipfftXtSetDistribution + function hipfftXtSetDistribution_(plan,rank,input_lower,input_upper,output_lower,output_upper, & + input_stride,output_stride) & + bind(c, name="hipfftXtSetDistribution") + import + implicit none + integer(c_int) :: hipfftXtSetDistribution_ + type(c_ptr),value :: plan + integer(c_int),value :: rank + type(c_ptr),value :: input_lower + type(c_ptr),value :: input_upper + type(c_ptr),value :: output_lower + type(c_ptr),value :: output_upper + type(c_ptr),value :: input_stride + type(c_ptr),value :: output_stride + end function + end interface + + interface hipfftXtSetSubformatDefault + function hipfftXtSetSubformatDefault_(plan,subformat_forward,subformat_inverse) & + bind(c, name="hipfftXtSetSubformatDefault") + import + implicit none + integer(c_int) :: hipfftXtSetSubformatDefault_ + type(c_ptr),value :: plan + integer(c_int),value :: subformat_forward + integer(c_int),value :: subformat_inverse + end function + end interface + + + contains + + function hipfftXtMakePlanMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + type(c_ptr) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_typed = hipfftXtMakePlanMany_(plan,rank,n,inembed,istride,idist, & + inputType,onembed,ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + + function hipfftXtGetSizeMany_typed(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_typed + type(c_ptr), value :: plan + integer(c_int) :: rank + type(c_ptr) :: n + type(c_ptr) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + type(c_ptr) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_typed = hipfftXtGetSizeMany_(plan,rank,n,inembed,istride,idist, & + inputType,onembed,ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + + +#if defined(USE_ASSUMED_SHAPE) || defined(USE_ASSUMED_RANK) + +#ifdef USE_ASSUMED_RANK + function hipfftXtMakePlanMany_assumed_rank(plan,rank,n,inembed,istride,idist,inputType, & + onembed,ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(..) :: n + integer(c_int64_t),target,dimension(..) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(..) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_assumed_rank = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + +#else + function hipfftXtMakePlanMany_rank_0(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target :: n + integer(c_int64_t),target :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_rank_0 = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + + function hipfftXtMakePlanMany_rank_1(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtMakePlanMany_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(:) :: n + integer(c_int64_t),target,dimension(:) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(:) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtMakePlanMany_rank_1 = hipfftXtMakePlanMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftXtGetSizeMany_assumed_rank(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(..) :: n + integer(c_int64_t),target,dimension(..) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(..) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_assumed_rank = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed), & + istride,idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize), & + executionType) + end function + +#else + function hipfftXtGetSizeMany_rank_0(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target :: n + integer(c_int64_t),target :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_rank_0 = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + + function hipfftXtGetSizeMany_rank_1(plan,rank,n,inembed,istride,idist,inputType,onembed, & + ostride,odist,outputType,batch,workSize,executionType) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtGetSizeMany_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: rank + integer(c_int64_t),target,dimension(:) :: n + integer(c_int64_t),target,dimension(:) :: inembed + integer(c_int64_t) :: istride + integer(c_int64_t) :: idist + integer(c_int) :: inputType + integer(c_int64_t),target,dimension(:) :: onembed + integer(c_int64_t) :: ostride + integer(c_int64_t) :: odist + integer(c_int) :: outputType + integer(c_int64_t) :: batch + integer(c_size_t),target :: workSize + integer(c_int) :: executionType + ! + hipfftXtGetSizeMany_rank_1 = hipfftXtGetSizeMany_(plan,rank,c_loc(n),c_loc(inembed),istride, & + idist,inputType,c_loc(onembed),ostride,odist,outputType,batch,c_loc(workSize),executionType) + end function + +#endif +#ifdef USE_ASSUMED_RANK + function hipfftXtSetGPUs_assumed_rank(plan,count,gpus) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_assumed_rank + type(c_ptr), value :: plan + integer(c_int) :: count + integer(c_int),target,dimension(..) :: gpus + ! + hipfftXtSetGPUs_assumed_rank = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) + end function + +#else + function hipfftXtSetGPUs_rank_0(plan,count,gpus) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_rank_0 + type(c_ptr), value :: plan + integer(c_int) :: count + integer(c_int),target :: gpus + ! + hipfftXtSetGPUs_rank_0 = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) + end function + + function hipfftXtSetGPUs_rank_1(plan,count,gpus) + implicit none + integer(kind(HIPFFT_SUCCESS)) :: hipfftXtSetGPUs_rank_1 + type(c_ptr), value :: plan + integer(c_int) :: count + integer(c_int),target,dimension(:) :: gpus + ! + hipfftXtSetGPUs_rank_1 = hipfftXtSetGPUs_(plan,count,c_loc(gpus)) + end function + +#endif +#endif +end module hipfftxt diff --git a/bindings/fortran/hipfft/metadata/hipfft.toml b/bindings/fortran/hipfft/metadata/hipfft.toml index 195d31f6640f..da4e502a020d 100644 --- a/bindings/fortran/hipfft/metadata/hipfft.toml +++ b/bindings/fortran/hipfft/metadata/hipfft.toml @@ -81,21 +81,3 @@ workSize = "scalar-host" [hipfftMakePlanMany64] workSize = "scalar-host" - -[hipfftXtGetSizeMany] -workSize = "scalar-host" - -[hipfftXtMakePlanMany] -workSize = "scalar-host" - -# hipfftMp.h's routines exist only in a hipFFT built with HIPFFT_MPI_ENABLE, which the -# ROCm packages are not: a wrapper that calls one leaves an undefined symbol in a -# shared libhipfort (hipfort's shared-link test). These arrays stay type(c_ptr), so -# the routine keeps its bind(C) interface alone, which costs nothing until called. -[hipfftXtSetDistribution] -input_lower = "always-c-ptr" -input_upper = "always-c-ptr" -output_lower = "always-c-ptr" -output_upper = "always-c-ptr" -input_stride = "always-c-ptr" -output_stride = "always-c-ptr" diff --git a/bindings/fortran/hipfft/metadata/hipfftxt.toml b/bindings/fortran/hipfft/metadata/hipfftxt.toml new file mode 100644 index 000000000000..5e8342f2a58f --- /dev/null +++ b/bindings/fortran/hipfft/metadata/hipfftxt.toml @@ -0,0 +1,32 @@ +# Copyright (C) 2026 Advanced Micro Devices, Inc. All rights reserved. +# SPDX-License-Identifier: MIT +# +# What the hipfftXt C headers (hipfftXt.h, hipfftMp.h) cannot express, beyond the +# defaults the generator derives from them: one table per C function, and a key +# with braces names several. A _64 or _spt variant without a table takes its +# base's. See "Fixing a binding" in the generator README; `gen.sh --explain +# ` shows what applies. + +format = 1 +# scalar-host: +# workSize stays a scalar, which is right for a plan on one GPU. On a plan spread +# over several GPUs (hipfftXtSetGPUs), hipFFT writes one work size per GPU: such a +# caller passes c_loc of an array to the bind(C) form. + +[hipfftXtGetSizeMany] +workSize = "scalar-host" + +[hipfftXtMakePlanMany] +workSize = "scalar-host" + +# hipfftMp.h's routines exist only in a hipFFT built with HIPFFT_MPI_ENABLE, which the +# ROCm packages are not: a wrapper that calls one leaves an undefined symbol in a +# shared libhipfort (hipfort's shared-link test). These arrays stay type(c_ptr), so +# the routine keeps its bind(C) interface alone, which costs nothing until called. +[hipfftXtSetDistribution] +input_lower = "always-c-ptr" +input_upper = "always-c-ptr" +output_lower = "always-c-ptr" +output_upper = "always-c-ptr" +input_stride = "always-c-ptr" +output_stride = "always-c-ptr" diff --git a/bindings/fortran/hipfft/test/hipfft_xt_descriptor_z.f03 b/bindings/fortran/hipfft/test/hipfft_xt_descriptor_z.f03 index 634191b815df..a4ed8ae921d9 100644 --- a/bindings/fortran/hipfft/test/hipfft_xt_descriptor_z.f03 +++ b/bindings/fortran/hipfft/test/hipfft_xt_descriptor_z.f03 @@ -26,7 +26,7 @@ program hipfft_xt_descriptor_z use iso_c_binding use hip - use hipfft + use hipfftxt implicit none diff --git a/bindings/fortran/hipfft/test/hipfft_xt_makeplanmany_c.f03 b/bindings/fortran/hipfft/test/hipfft_xt_makeplanmany_c.f03 index 012cf75a2706..4bcd27d03251 100644 --- a/bindings/fortran/hipfft/test/hipfft_xt_makeplanmany_c.f03 +++ b/bindings/fortran/hipfft/test/hipfft_xt_makeplanmany_c.f03 @@ -26,7 +26,7 @@ program hipfft_xt_makeplanmany_c use iso_c_binding use hip - use hipfft + use hipfftxt implicit none From 72ea7a2bca5e10c4adfea15f4e34b3e2a2b00303 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 7 Nov 2026 02:26:48 -0600 Subject: [PATCH 08/12] chore(hipfft): move hipfftXtSetWorkArea to the hipfftxt module Every hipfftXt* and hipfftMp* function is now in hipfftxt, as cufftXtSetWorkArea is in CUDA Fortran's cufftXt module, although hipfft.h declares hipfftXtSetWorkArea. Regenerated with ROCm/rocm-fortran-generator#17. --- bindings/fortran/hipfft/hipfft.F90 | 10 ---------- bindings/fortran/hipfft/hipfftxt.F90 | 10 ++++++++++ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/bindings/fortran/hipfft/hipfft.F90 b/bindings/fortran/hipfft/hipfft.F90 index e96a52f23037..225fece4731d 100644 --- a/bindings/fortran/hipfft/hipfft.F90 +++ b/bindings/fortran/hipfft/hipfft.F90 @@ -493,16 +493,6 @@ function hipfftSetWorkArea_(plan,workArea) bind(c, name="hipfftSetWorkArea") end function end interface - interface hipfftXtSetWorkArea - function hipfftXtSetWorkArea_(plan,workArea) bind(c, name="hipfftXtSetWorkArea") - import - implicit none - integer(c_int) :: hipfftXtSetWorkArea_ - type(c_ptr),value :: plan - type(c_ptr) :: workArea - end function - end interface - interface hipfftExecC2C function hipfftExecC2C_(plan,idata,odata,direction) bind(c, name="hipfftExecC2C") import diff --git a/bindings/fortran/hipfft/hipfftxt.F90 b/bindings/fortran/hipfft/hipfftxt.F90 index 6f8e158642df..4a6e9cdb064f 100644 --- a/bindings/fortran/hipfft/hipfftxt.F90 +++ b/bindings/fortran/hipfft/hipfftxt.F90 @@ -92,6 +92,16 @@ module hipfftxt end type hipLibXtDesc + interface hipfftXtSetWorkArea + function hipfftXtSetWorkArea_(plan,workArea) bind(c, name="hipfftXtSetWorkArea") + import + implicit none + integer(c_int) :: hipfftXtSetWorkArea_ + type(c_ptr),value :: plan + type(c_ptr) :: workArea + end function + end interface + interface hipfftXtSetCallback function hipfftXtSetCallback_(plan,callbacks,cbtype,callbackData) & bind(c, name="hipfftXtSetCallback") From ec091e01cc35f93969fed43ce87ee931812a198c Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 7 Nov 2026 02:28:04 -0600 Subject: [PATCH 09/12] docs(hipfft): describe the hipfftxt module by its functions, not its headers --- bindings/fortran/hipfft/CHANGELOG.md | 6 +++--- bindings/fortran/hipfft/CMakeLists.txt | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/bindings/fortran/hipfft/CHANGELOG.md b/bindings/fortran/hipfft/CHANGELOG.md index 64a16466e237..c066e152315c 100644 --- a/bindings/fortran/hipfft/CHANGELOG.md +++ b/bindings/fortran/hipfft/CHANGELOG.md @@ -4,9 +4,9 @@ ### Added -* Generated Fortran bindings, one module per C header, as CUDA Fortran's `cufft` and `cufftXt`: - `use hipfft` (`hipfft.h`) or `use hipfftxt` (`hipfftXt.h` and `hipfftMp.h`; it uses and re-exports - `hipfft`, so it alone gives the whole API) and link `hip::hipfft_fortran`, or `use hipfftw` +* Generated Fortran bindings, split as CUDA Fortran's `cufft` and `cufftXt`: `use hipfft`, or + `use hipfftxt` (every `hipfftXt*` and `hipfftMp*` function; it uses and re-exports `hipfft`, so + it alone gives the whole API), and link `hip::hipfft_fortran`; or `use hipfftw` (`hipfftw.h`) and link `hip::hipfftw_fortran` for the FFTW compatibility API. Fortran is case-insensitive, so `use hipfftXt` works too. Controlled by `BUILD_FORTRAN_BINDINGS` (on by default on Linux, off on Windows), diff --git a/bindings/fortran/hipfft/CMakeLists.txt b/bindings/fortran/hipfft/CMakeLists.txt index 9a1619b6db33..3ddcc4b14652 100644 --- a/bindings/fortran/hipfft/CMakeLists.txt +++ b/bindings/fortran/hipfft/CMakeLists.txt @@ -24,9 +24,9 @@ # Fortran bindings for hipFFT and hipFFTW. hipfft.F90, hipfftxt.F90 and # hipfftw.F90 are GENERATED by the rocm-fortran generator: regenerate them, do -# not edit them. One module per C header: hipfft (hipfft.h), hipfftxt -# (hipfftXt.h and hipfftMp.h; it uses and re-exports hipfft) and hipfftw -# (hipfftw.h, independent of the other two). +# not edit them. As CUDA Fortran's cufft and cufftXt: hipfft, and hipfftxt +# (every hipfftXt* and hipfftMp* function; it uses and re-exports hipfft). hipfftw +# (hipfftw.h) is independent of the other two. cmake_minimum_required(VERSION 3.19) From ebda818abe2f76ece9d382ed09fd677c9459ff01 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 7 Nov 2026 12:05:05 -0600 Subject: [PATCH 10/12] fix(hipfft): install the Fortran package config in lib/cmake/hipfft-fortran and lib/cmake/hipfftw-fortran The package files went to lib/cmake/hipfft, the C library's directory, with a forwarder in lib/cmake/hipfft-fortran and lib/cmake/hipfftw-fortran. rocRAND and hipRAND install their own legacy -fortran-config.cmake there, so the files overlapped. Install the config, targets and version files directly where find_package() looks, as the HIP and ROCTx bindings do, and drop the forwarder. --- bindings/fortran/hipfft/CMakeLists.txt | 50 +++++++------------------- 1 file changed, 12 insertions(+), 38 deletions(-) diff --git a/bindings/fortran/hipfft/CMakeLists.txt b/bindings/fortran/hipfft/CMakeLists.txt index 3ddcc4b14652..8a65a335b272 100644 --- a/bindings/fortran/hipfft/CMakeLists.txt +++ b/bindings/fortran/hipfft/CMakeLists.txt @@ -221,7 +221,10 @@ set(HIPFFT_FORTRAN_INCLUDEDIR "${CMAKE_INSTALL_INCLUDEDIR}/fortran") set(HIPFFTW_FORTRAN_LIBDIR "${HIPFFT_FORTRAN_LIBDIR}") set(HIPFFTW_FORTRAN_INCLUDEDIR "${HIPFFT_FORTRAN_INCLUDEDIR}") -# Two independent packages, both in lib/cmake/hipfft beside hipfft-config.cmake. +# Two independent packages, each in its own lib/cmake/ directory. +set(_hipfft_pkgdir "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran") +set(_hipfftw_pkgdir "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran") + install(TARGETS hipfft_fortran EXPORT hipfft-fortran-targets ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}/fortran/${HIPFFT_FORTRAN_COMPILER_DIR}" @@ -229,7 +232,7 @@ install(TARGETS hipfft_fortran install(EXPORT hipfft-fortran-targets FILE hipfft-fortran-targets.cmake NAMESPACE hip:: - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + DESTINATION "${_hipfft_pkgdir}" COMPONENT devel) # Under share/: the config reads every entry of include/fortran/ as a compiler. @@ -241,22 +244,10 @@ install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfft.F90" configure_package_config_file( "${CMAKE_CURRENT_SOURCE_DIR}/hipfft-fortran-config.cmake.in" "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" - INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + INSTALL_DESTINATION "${_hipfft_pkgdir}" PATH_VARS HIPFFT_FORTRAN_LIBDIR HIPFFT_FORTRAN_INCLUDEDIR) install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - -# find_package(hipfft-fortran) searches lib/cmake/hipfft-fortran*. -file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" -"# Generated forwarder. The real config lives beside the hipFFT C package, in -# lib/cmake/hipfft, so that one CMAKE_PREFIX_PATH entry finds both. -# This file only exists so that find_package(hipfft-fortran) resolves to the -# same place. -include(\"\${CMAKE_CURRENT_LIST_DIR}/../hipfft/hipfft-fortran-config.cmake\") -") -install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfft-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" + DESTINATION "${_hipfft_pkgdir}" COMPONENT devel) if(_fortran_version) @@ -264,12 +255,8 @@ if(_fortran_version) "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" VERSION "${_fortran_version}" COMPATIBILITY SameMajorVersion) - # Beside both the config and the forwarder. - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfft-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft-fortran" + DESTINATION "${_hipfft_pkgdir}" COMPONENT devel) endif() @@ -280,7 +267,7 @@ install(TARGETS hipfftw_fortran install(EXPORT hipfftw-fortran-targets FILE hipfftw-fortran-targets.cmake NAMESPACE hip:: - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + DESTINATION "${_hipfftw_pkgdir}" COMPONENT devel) install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw.F90" @@ -290,20 +277,10 @@ install(FILES "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw.F90" configure_package_config_file( "${CMAKE_CURRENT_SOURCE_DIR}/hipfftw-fortran-config.cmake.in" "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" - INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" + INSTALL_DESTINATION "${_hipfftw_pkgdir}" PATH_VARS HIPFFTW_FORTRAN_LIBDIR HIPFFTW_FORTRAN_INCLUDEDIR) install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - -file(WRITE "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" -"# Generated forwarder. hipFFTW ships inside the hipFFT package, so the real -# config lives in lib/cmake/hipfft beside hipfft-config.cmake. This file only -# exists so that find_package(hipfftw-fortran) resolves to the same place. -include(\"\${CMAKE_CURRENT_LIST_DIR}/../hipfft/hipfftw-fortran-config.cmake\") -") -install(FILES "${CMAKE_CURRENT_BINARY_DIR}/forward/hipfftw-fortran-config.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" + DESTINATION "${_hipfftw_pkgdir}" COMPONENT devel) if(_fortran_version) @@ -312,9 +289,6 @@ if(_fortran_version) VERSION "${_fortran_version}" COMPATIBILITY SameMajorVersion) install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfft" - COMPONENT devel) - install(FILES "${CMAKE_CURRENT_BINARY_DIR}/hipfftw-fortran-config-version.cmake" - DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/hipfftw-fortran" + DESTINATION "${_hipfftw_pkgdir}" COMPONENT devel) endif() From 38cb1149950355fffb9785eb0f69b05752ab9440 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 7 Nov 2026 19:56:50 -0600 Subject: [PATCH 11/12] fix(hipfft): let hipfft-config.cmake load the Fortran package without recursion rocm-cmake's generated hipfft-config.cmake is to include lib/cmake/hipfft-fortran/hipfft-fortran-config.cmake after its targets (ROCm/rocm-cmake#303). Skip find_dependency(hipfft) when hipfft is the package being found, not only when hip::hipfft (hip::hipfftw for hipfftw-fortran) is already imported, so that include never re-enters hipfft-config.cmake. --- bindings/fortran/hipfft/hipfft-fortran-config.cmake.in | 4 +++- bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in b/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in index 83bec1cb69ae..f89c70210c5d 100644 --- a/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in +++ b/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in @@ -128,7 +128,9 @@ endif() # Written TRUE only when the archive links hip::hipfft, which must be imported # before the targets file. hip's config needs C or CXX enabled (FindThreads). if(@HIPFFT_FORTRAN_NEEDS_HIPFFT_PACKAGE@) - if(NOT TARGET hip::hipfft) + # Not from hipfft-config.cmake, which includes the Fortran package after its targets. + string(TOLOWER "${CMAKE_FIND_PACKAGE_NAME}" _hipfft_caller) + if(NOT TARGET hip::hipfft AND NOT _hipfft_caller STREQUAL "hipfft") if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) enable_language(C) endif() diff --git a/bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in b/bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in index 6655b29d05dc..676772177522 100644 --- a/bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in +++ b/bindings/fortran/hipfft/hipfftw-fortran-config.cmake.in @@ -128,7 +128,9 @@ endif() # Written TRUE only when the archive links hip::hipfftw, which must be imported # before the targets file. hip's config needs C or CXX enabled (FindThreads). if(@HIPFFTW_FORTRAN_NEEDS_HIPFFT_PACKAGE@) - if(NOT TARGET hip::hipfftw) + # Not from hipfft-config.cmake, which includes the Fortran package after its targets. + string(TOLOWER "${CMAKE_FIND_PACKAGE_NAME}" _hipfftw_caller) + if(NOT TARGET hip::hipfftw AND NOT _hipfftw_caller STREQUAL "hipfft") if(NOT CMAKE_C_COMPILER_LOADED AND NOT CMAKE_CXX_COMPILER_LOADED) enable_language(C) endif() From f5d7252fca05a35822f272fa7814dae198e81793 Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 7 Nov 2026 21:07:56 -0600 Subject: [PATCH 12/12] fix(hipfft): load the hipFFTW Fortran package with hipFFT's hipFFTW is built and exported with hipFFT, so hipfft-config.cmake defines both hip::hipfft and hip::hipfftw. hipfft-fortran-config.cmake now includes hipfftw-fortran-config.cmake when installed, so find_package(hipfft) (through the rocm-cmake hook) and find_package(hipfft-fortran) also give hip::hipfftw_fortran. The include is optional and its failure only sets hipfftw-fortran_* variables, so hipfft-fortran is still found without it. --- bindings/fortran/hipfft/hipfft-fortran-config.cmake.in | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in b/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in index f89c70210c5d..b3d65477f159 100644 --- a/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in +++ b/bindings/fortran/hipfft/hipfft-fortran-config.cmake.in @@ -156,3 +156,10 @@ endif() set(hipfft_FORTRAN_FOUND TRUE) check_required_components(hipfft-fortran) + +# hipFFTW ships with hipFFT, so its bindings come along when installed. Their +# config only sets hipfftw-fortran_* variables: a failure there leaves this +# package found. +if(NOT TARGET hip::hipfftw_fortran) + include("${CMAKE_CURRENT_LIST_DIR}/../hipfftw-fortran/hipfftw-fortran-config.cmake" OPTIONAL) +endif()