Skip to content

Commit

Permalink
WIP - Adjoint INV_TRANS_CTL - Adjoint the subroutine.
Browse files Browse the repository at this point in the history
  • Loading branch information
@l90lpa
l90lpa committed Feb 7, 2025
1 parent f4af3d4 commit 1f216b1
Showing 1 changed file with 62 additions and 63 deletions.
125 changes: 62 additions & 63 deletions src/trans/gpu/internal/inv_trans_ctlad_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,22 +9,22 @@
! nor does it submit to any jurisdiction.
!

MODULE INV_TRANS_CTL_MOD
MODULE INV_TRANS_CTLAD_MOD
CONTAINS
SUBROUTINE INV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,&
SUBROUTINE INV_TRANS_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,&
& KF_UV,KF_SCALARS,KF_SCDERS,&
& PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,FSPGL_PROC,&
& PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2)

!**** *INV_TRANS_CTL* - Control routine for inverse spectral transform.
!**** *INV_TRANS_CTLAD* - Control routine for adjoint of the inverse spectral transform.

! Purpose.
! --------
! Control routine for the inverse spectral transform
! Control routine for the adjoint of the inverse spectral transform

!** Interface.
! ----------
! CALL INV_TRANS_CTL(...)
! CALL INV_TRANS_CTLAD(...)

! Explicit arguments :
! --------------------
Expand Down Expand Up @@ -90,16 +90,15 @@ SUBROUTINE INV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,&
USE TPM_GEN, ONLY: NPROMATR, NOUT
USE TPM_TRANS, ONLY: LDIVGP, LSCDERS, LUVDER, LVORGP, GROWING_ALLOCATION
USE ABORT_TRANS_MOD, ONLY: ABORT_TRANS
USE BUFFERED_ALLOCATOR_MOD, ONLY: BUFFERED_ALLOCATOR, MAKE_BUFFERED_ALLOCATOR, &
& INSTANTIATE_ALLOCATOR
USE TRMTOL_MOD, ONLY: PREPARE_TRMTOL, TRMTOL_HANDLE, TRMTOL
USE LTINV_MOD, ONLY: PREPARE_LTINV, LTINV_HANDLE, LTINV
USE TRMTOL_PACK_UNPACK, ONLY: TRMTOL_PACK_HANDLE, TRMTOL_UNPACK_HANDLE, &
& PREPARE_TRMTOL_PACK, PREPARE_TRMTOL_UNPACK, TRMTOL_PACK, &
& TRMTOL_UNPACK
USE FSC_MOD, ONLY: FSC_HANDLE, PREPARE_FSC, FSC
USE BUFFERED_ALLOCATOR_MOD, ONLY: BUFFERED_ALLOCATOR, MAKE_BUFFERED_ALLOCATOR, INSTANTIATE_ALLOCATOR
USE TRMTOLAD_MOD, ONLY: PREPARE_TRMTOLAD, TRMTOLAD_HANDLE, TRMTOLAD
USE LTINVAD_MOD, ONLY: PREPARE_LTINVAD, LTINVAD_HANDLE, LTINVAD
USE TRMTOLAD_PACK_UNPACK, ONLY: TRMTOLAD_PACK_HANDLE, TRMTOLAD_UNPACK_HANDLE, &
& PREPARE_TRMTOLAD_PACK, PREPARE_TRMTOLAD_UNPACK, TRMTOLAD_PACK, &
& TRMTOLAD_UNPACK
USE FSCAD_MOD, ONLY: FSCAD_HANDLE, PREPARE_FSCAD, FSCAD
USE FTINV_MOD, ONLY: FTINV_HANDLE, PREPARE_FTINV, FTINV
USE TRLTOG_MOD, ONLY: TRLTOG_HANDLE, PREPARE_TRLTOG, TRLTOG
USE TRGTOL_MOD, ONLY: TRGTOL_HANDLE, PREPARE_TRGTOL, TRGTOL

IMPLICIT NONE

Expand All @@ -113,24 +112,24 @@ SUBROUTINE INV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,&
INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV
INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS
INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCDERS
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPVOR(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPDIV(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSCALAR(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3A(:,:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3B(:,:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC2(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:)
REAL(KIND=JPRB) ,OPTIONAL ,INTENT(OUT) :: PGP(:,:,:)
REAL(KIND=JPRB) ,OPTIONAL ,INTENT(IN) :: PGP(:,:,:)
EXTERNAL FSPGL_PROC
OPTIONAL FSPGL_PROC
REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGPUV(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3A(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3B(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP2(:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGPUV(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP3A(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP3B(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP2(:,:,:)

! Local variables

Expand All @@ -145,13 +144,13 @@ SUBROUTINE INV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,&
INTEGER(KIND=JPIM) :: IFIRST

TYPE(BUFFERED_ALLOCATOR) :: ALLOCATOR
TYPE(LTINV_HANDLE) :: HLTINV
TYPE(TRMTOL_PACK_HANDLE) :: HTRMTOL_PACK
TYPE(TRMTOL_HANDLE) :: HTRMTOL
TYPE(TRMTOL_UNPACK_HANDLE) :: HTRMTOL_UNPACK
TYPE(FSC_HANDLE) :: HFSC
TYPE(LTINVAD_HANDLE) :: HLTINVAD
TYPE(TRMTOLAD_PACK_HANDLE) :: HTRMTOL_PACK
TYPE(TRMTOLAD_HANDLE) :: HTRMTOL
TYPE(TRMTOLAD_UNPACK_HANDLE) :: HTRMTOL_UNPACK
TYPE(FSCAD_HANDLE) :: HFSC
TYPE(FTINV_HANDLE) :: HFTINV
TYPE(TRLTOG_HANDLE) :: HTRLTOG
TYPE(TRGTOL_HANDLE) :: HTRGTOL

INTEGER(KIND=C_INT8_T), POINTER :: PTR(:)

Expand Down Expand Up @@ -196,50 +195,50 @@ SUBROUTINE INV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,&
IF (IF_FOURIER /= KF_FS) CALL ABORT_TRANS('Size mismatch: Wrong computation KF_FS')

ALLOCATOR = MAKE_BUFFERED_ALLOCATOR()
HTRGTOL = PREPARE_TRGTOL(ALLOCATOR,KF_GP,IF_FOURIER)
IF (KF_FS > 0) THEN
HLTINV = PREPARE_LTINV(ALLOCATOR,KF_UV,KF_SCALARS,LVORGP,LDIVGP,LSCDERS)
HTRMTOL_PACK = PREPARE_TRMTOL_PACK(ALLOCATOR,IF_LEG)
HTRMTOL = PREPARE_TRMTOL(ALLOCATOR,IF_LEG)
HTRMTOL_UNPACK = PREPARE_TRMTOL_UNPACK(ALLOCATOR,IF_FOURIER)
HFSC = PREPARE_FSC(ALLOCATOR)
HFTINV = PREPARE_FTINV(ALLOCATOR,IF_FOURIER)
HFSC = PREPARE_FSCAD(ALLOCATOR)
HTRMTOL_UNPACK = PREPARE_TRMTOLAD_UNPACK(ALLOCATOR,IF_LEG)
HTRMTOL = PREPARE_TRMTOLAD(ALLOCATOR,IF_LEG)
HTRMTOL_PACK = PREPARE_TRMTOLAD_PACK(ALLOCATOR,KF_UV,KF_SCALARS,LVORGP,LDIVGP,LSCDERS)
HLTINVAD = PREPARE_LTINVAD(ALLOCATOR,KF_UV,KF_SCALARS,LVORGP,LDIVGP,LSCDERS)
ENDIF
HTRLTOG = PREPARE_TRLTOG(ALLOCATOR,IF_FOURIER,KF_GP)

CALL INSTANTIATE_ALLOCATOR(ALLOCATOR, GROWING_ALLOCATION)

! Adjoint of transposition into grid-point space
CALL GSTATS(157,0)
CALL TRGTOL(ALLOCATOR,HTRGTOL,PREEL_REAL,IF_FOURIER,KF_GP,KF_UV_G,KF_SCALARS_G,&
& KVSETUV=KVSETUV,KVSETSC=KVSETSC,&
& KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,&
& PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2)
CALL GSTATS(157,1)

IF (KF_FS > 0) THEN
CALL GSTATS(107,0)
! Fourier transformations
! CALL FTINVAD(ALLOCATOR, HFTINV, PREEL_COMPLEX,PREEL_REAL,IF_FOURIER)
! compute NS derivatives
CALL FSCAD(ALLOCATOR,HFSC,PREEL_COMPLEX, IF_FOURIER, KF_UV, KF_SCALARS, KUV_OFFSET, KSCALARS_OFFSET, &
& KSCALARS_NSDER_OFFSET, KUV_EWDER_OFFSET, KSCALARS_EWDER_OFFSET)
CALL GSTATS(107,1)

! Packing into send buffer, to fourier space and unpack
CALL GSTATS(152,0)
CALL TRMTOLAD_UNPACK(ALLOCATOR,HTRMTOL_UNPACK,FOUBUF,PREEL_COMPLEX,IF_LEG,IF_FOURIER)
CALL TRMTOLAD(ALLOCATOR,HTRMTOL,FOUBUF_IN,FOUBUF,IF_LEG)
CALL TRMTOLAD_PACK(ALLOCATOR,HTRMTOL_PACK,ZOUTS,ZOUTA,ZOUTS0,ZOUTA0,FOUBUF_IN,IF_LEG)
CALL GSTATS(152,1)

! Legendre transformations
CALL GSTATS(102,0)
CALL LTINV(ALLOCATOR,HLTINV,KF_UV,KF_SCALARS,&
CALL LTINVAD(ALLOCATOR,HLTINVAD,KF_UV,KF_SCALARS,&
& PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2, &
& ZOUTS,ZOUTA,ZOUTS0,ZOUTA0)
CALL GSTATS(102,1)

! Packing into send buffer, to fourier space and unpack
CALL GSTATS(152,0)
CALL TRMTOL_PACK(ALLOCATOR,HTRMTOL_PACK,ZOUTS,ZOUTA,ZOUTS0,ZOUTA0,FOUBUF_IN,IF_LEG)
CALL TRMTOL(ALLOCATOR,HTRMTOL,FOUBUF_IN,FOUBUF,IF_LEG)
CALL TRMTOL_UNPACK(ALLOCATOR,HTRMTOL_UNPACK,FOUBUF,PREEL_COMPLEX,IF_LEG,IF_FOURIER)
CALL GSTATS(152,1)

CALL GSTATS(107,0)
! compute NS derivatives
CALL FSC(ALLOCATOR,HFSC,PREEL_COMPLEX, IF_FOURIER, KF_UV, KF_SCALARS, KUV_OFFSET, KSCALARS_OFFSET, &
& KSCALARS_NSDER_OFFSET, KUV_EWDER_OFFSET, KSCALARS_EWDER_OFFSET)
!Legendre transformations
CALL FTINV(ALLOCATOR, HFTINV, PREEL_COMPLEX,PREEL_REAL,IF_FOURIER)
CALL GSTATS(107,1)
ENDIF

! Transposition into grid-point space
CALL GSTATS(157,0)
CALL TRLTOG(ALLOCATOR,HTRLTOG,PREEL_REAL,IF_FOURIER,KF_GP,KF_UV_G,KF_SCALARS_G,&
& KVSETUV=KVSETUV,KVSETSC=KVSETSC,&
& KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,&
& PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2)
CALL GSTATS(157,1)

END SUBROUTINE INV_TRANS_CTL
END MODULE INV_TRANS_CTL_MOD
END SUBROUTINE INV_TRANS_CTLAD
END MODULE INV_TRANS_CTLAD_MOD

0 comments on commit 1f216b1

Please sign in to comment.