! Distributed spectral transforms on LOCAL arrays (the resolution must have been set ! up with LDSPLIT=.TRUE.). Spectral local arrays are (KSPEC2, KFLD) in ecTrans model ! order; grid local arrays are (KGPTOT, KFLD) as a single NPROMA block. Single precision. SUBROUTINE INV_TRANS_SCALAR_DIST4PY(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PSPEC, PGP) ! Inverse transform of scalar fields: local spectral -> local grid-point. USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(IN) :: PSPEC REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(OUT) :: PGP REAL(KIND=JPRB) :: ZSP(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGP(KGPTOT, KFLD, 1) INTEGER(KIND=JPIM) :: JL #include "inv_trans.h" KRETURNCODE = 0 DO JL = 1, KFLD ZSP(JL, :) = PSPEC(:, JL) ENDDO CALL INV_TRANS(PSPSCALAR=ZSP, PGP=ZGP, KPROMA=INT(KGPTOT,JPIM)) PGP(:, :) = ZGP(:, :, 1) END SUBROUTINE INV_TRANS_SCALAR_DIST4PY SUBROUTINE INV_TRANS_SCALAR_DERS_DIST4PY(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PSPEC, PGP, PGPNS, PGPEW) ! Inverse transform of scalar fields WITH horizontal derivatives (LDSCDERS=.TRUE.): ! local spectral -> local grid value PGP, N-S derivative PGPNS, E-W derivative PGPEW. ! With LDSCDERS the PGP output holds 3*KFLD fields: [values, N-S derivs, E-W derivs]. USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(IN) :: PSPEC REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(OUT) :: PGP, PGPNS, PGPEW REAL(KIND=JPRB) :: ZSP(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGP(KGPTOT, 3*KFLD, 1) INTEGER(KIND=JPIM) :: JL #include "inv_trans.h" KRETURNCODE = 0 DO JL = 1, KFLD ZSP(JL, :) = PSPEC(:, JL) ENDDO CALL INV_TRANS(PSPSCALAR=ZSP, PGP=ZGP, LDSCDERS=.TRUE., KPROMA=INT(KGPTOT,JPIM)) ! field order (see inv_trans.h): values | N-S derivatives | E-W derivatives PGP (:, :) = ZGP(:, 1:KFLD, 1) PGPNS(:, :) = ZGP(:, KFLD+1:2*KFLD, 1) PGPEW(:, :) = ZGP(:, 2*KFLD+1:3*KFLD, 1) END SUBROUTINE INV_TRANS_SCALAR_DERS_DIST4PY SUBROUTINE DIR_TRANS_SCALAR_DIST4PY(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PGP, PSPEC) ! Direct transform of scalar fields: local grid-point -> local spectral. USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(IN) :: PGP REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(OUT) :: PSPEC REAL(KIND=JPRB) :: ZSP(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGP(KGPTOT, KFLD, 1) INTEGER(KIND=JPIM) :: JL #include "dir_trans.h" KRETURNCODE = 0 ZGP(:, :, 1) = PGP(:, :) CALL DIR_TRANS(PSPSCALAR=ZSP, PGP=ZGP, KPROMA=INT(KGPTOT,JPIM)) DO JL = 1, KFLD PSPEC(:, JL) = ZSP(JL, :) ENDDO END SUBROUTINE DIR_TRANS_SCALAR_DIST4PY SUBROUTINE INV_TRANS_UV_DIST4PY(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PSPVOR, PSPDIV, PGPU, PGPV) ! Inverse transform vorticity/divergence -> u,v winds (local). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(IN) :: PSPVOR, PSPDIV REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(OUT) :: PGPU, PGPV REAL(KIND=JPRB) :: ZVOR(KFLD, KSPEC2), ZDIV(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGPUV(KGPTOT, KFLD, 2, 1) INTEGER(KIND=JPIM) :: JL #include "inv_trans.h" KRETURNCODE = 0 DO JL = 1, KFLD ZVOR(JL, :) = PSPVOR(:, JL) ZDIV(JL, :) = PSPDIV(:, JL) ENDDO CALL INV_TRANS(PSPVOR=ZVOR, PSPDIV=ZDIV, PGPUV=ZGPUV, KPROMA=INT(KGPTOT,JPIM)) PGPU(:, :) = ZGPUV(:, :, 1, 1) PGPV(:, :) = ZGPUV(:, :, 2, 1) END SUBROUTINE INV_TRANS_UV_DIST4PY SUBROUTINE DIR_TRANS_UV_DIST4PY(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PGPU, PGPV, PSPVOR, PSPDIV) ! Direct transform u,v winds -> vorticity/divergence (local). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(IN) :: PGPU, PGPV REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(OUT) :: PSPVOR, PSPDIV REAL(KIND=JPRB) :: ZVOR(KFLD, KSPEC2), ZDIV(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGPUV(KGPTOT, KFLD, 2, 1) INTEGER(KIND=JPIM) :: JL #include "dir_trans.h" KRETURNCODE = 0 ZGPUV(:, :, 1, 1) = PGPU(:, :) ZGPUV(:, :, 2, 1) = PGPV(:, :) CALL DIR_TRANS(PSPVOR=ZVOR, PSPDIV=ZDIV, PGPUV=ZGPUV, KPROMA=INT(KGPTOT,JPIM)) DO JL = 1, KFLD PSPVOR(:, JL) = ZVOR(JL, :) PSPDIV(:, JL) = ZDIV(JL, :) ENDDO END SUBROUTINE DIR_TRANS_UV_DIST4PY SUBROUTINE INV_TRANS_SCALAR_DIST4PY_AD(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PGP, PSPEC) ! Adjoint of INV_TRANS_SCALAR_DIST4PY (INV_TRANSAD): grid-point seed PGP (IN) -> spectral PSPEC (OUT). ! INV_TRANSAD *appends* to the spectral output arrays (PRFI1BAD), so ZSP must be zeroed first. ! Inner-product identity: <INV_TRANS x, y>_Euclid = <x, INV_TRANSAD y>_mfold ! where _mfold applies factor 2 for m>0 spectral coefficients (SCALPRODSP convention). ! Note: adj(INV_TRANS) = S^T != S^T W = DIR_TRANS (they differ by the Gaussian weights W). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(IN) :: PGP ! INPUT: grid-point seed REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(OUT) :: PSPEC ! OUTPUT: spectral result REAL(KIND=JPRB) :: ZSP(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGP(KGPTOT, KFLD, 1) INTEGER(KIND=JPIM) :: JL #include "inv_transad.h" KRETURNCODE = 0 ZSP(:,:) = 0.0_JPRB ! zero before INV_TRANSAD: PRFI1BAD appends to spectral output ZGP(:, :, 1) = PGP(:, :) CALL INV_TRANSAD(PSPSCALAR=ZSP, PGP=ZGP, KPROMA=INT(KGPTOT,JPIM)) DO JL = 1, KFLD PSPEC(:, JL) = ZSP(JL, :) ENDDO END SUBROUTINE INV_TRANS_SCALAR_DIST4PY_AD SUBROUTINE INV_TRANS_SCALAR_DERS_DIST4PY_AD(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PGP, PGPNS, PGPEW, PSPEC) ! Adjoint of INV_TRANS_SCALAR_DERS_DIST4PY (INV_TRANSAD, LDSCDERS=.TRUE.): grid-point ! value seed PGP, N-S derivative seed PGPNS, E-W derivative seed PGPEW (all IN) -> ! spectral PSPEC (OUT), the adjoint accumulating all three contributions in a single ! call (matches the real INV_TRANSAD's own LDSCDERS support -- the derivative adjoint ! is "transpose of the i*m / associated-Legendre-recurrence rescale, then the ordinary ! Legendre-transform adjoint", already implemented internally by INV_TRANSAD; this ! wrapper only exposes the existing LDSCDERS argument, it adds no new transform maths). ! INV_TRANSAD *appends* to the spectral output arrays (PRFI1BAD), so ZSP must be ! zeroed first (same convention as INV_TRANS_SCALAR_DIST4PY_AD). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(IN) :: PGP, PGPNS, PGPEW ! INPUT: seeds REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(OUT) :: PSPEC ! OUTPUT: spectral result REAL(KIND=JPRB) :: ZSP(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGP(KGPTOT, 3*KFLD, 1) INTEGER(KIND=JPIM) :: JL #include "inv_transad.h" KRETURNCODE = 0 ZSP(:,:) = 0.0_JPRB ! zero before INV_TRANSAD: PRFI1BAD appends to spectral output ! field order (see inv_trans.h / INV_TRANS_SCALAR_DERS_DIST4PY): values | N-S | E-W ZGP(:, 1:KFLD, 1) = PGP (:, :) ZGP(:, KFLD+1:2*KFLD, 1) = PGPNS(:, :) ZGP(:, 2*KFLD+1:3*KFLD, 1) = PGPEW(:, :) CALL INV_TRANSAD(PSPSCALAR=ZSP, PGP=ZGP, LDSCDERS=.TRUE., KPROMA=INT(KGPTOT,JPIM)) DO JL = 1, KFLD PSPEC(:, JL) = ZSP(JL, :) ENDDO END SUBROUTINE INV_TRANS_SCALAR_DERS_DIST4PY_AD SUBROUTINE DIR_TRANS_SCALAR_DIST4PY_AD(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PSPEC, PGP) ! Adjoint of DIR_TRANS_SCALAR_DIST4PY (DIR_TRANSAD): spectral seed PSPEC (IN) -> grid PGP (OUT). ! Inner-product identity: <DIR_TRANS u, v>_mfold = <u, DIR_TRANSAD v>_Euclid USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(IN) :: PSPEC ! INPUT: spectral seed REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(OUT) :: PGP ! OUTPUT: grid result REAL(KIND=JPRB) :: ZSP(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGP(KGPTOT, KFLD, 1) INTEGER(KIND=JPIM) :: JL #include "dir_transad.h" KRETURNCODE = 0 DO JL = 1, KFLD ZSP(JL, :) = PSPEC(:, JL) ENDDO ZGP(:,:,:) = 0.0_JPRB CALL DIR_TRANSAD(PSPSCALAR=ZSP, PGP=ZGP, KPROMA=INT(KGPTOT,JPIM)) PGP(:, :) = ZGP(:, :, 1) END SUBROUTINE DIR_TRANS_SCALAR_DIST4PY_AD SUBROUTINE INV_TRANS_UV_DIST4PY_AD(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PGPU, PGPV, PSPVOR, PSPDIV) ! Adjoint of INV_TRANS_UV_DIST4PY (INV_TRANSAD): grid u,v seeds (IN) -> spectral vor,div (OUT). ! ZVOR/ZDIV zeroed before INV_TRANSAD (same appending convention as scalar adjoint). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(IN) :: PGPU, PGPV REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(OUT) :: PSPVOR, PSPDIV REAL(KIND=JPRB) :: ZVOR(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZDIV(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGPUV(KGPTOT, KFLD, 2, 1) INTEGER(KIND=JPIM) :: JL #include "inv_transad.h" KRETURNCODE = 0 ZVOR(:,:) = 0.0_JPRB ZDIV(:,:) = 0.0_JPRB ZGPUV(:, :, 1, 1) = PGPU(:, :) ZGPUV(:, :, 2, 1) = PGPV(:, :) CALL INV_TRANSAD(PSPVOR=ZVOR, PSPDIV=ZDIV, PGPUV=ZGPUV, KPROMA=INT(KGPTOT,JPIM)) DO JL = 1, KFLD PSPVOR(:, JL) = ZVOR(JL, :) PSPDIV(:, JL) = ZDIV(JL, :) ENDDO END SUBROUTINE INV_TRANS_UV_DIST4PY_AD SUBROUTINE DIR_TRANS_UV_DIST4PY_AD(KRETURNCODE, KSPEC2, KGPTOT, KFLD, PSPVOR, PSPDIV, PGPU, PGPV) ! Adjoint of DIR_TRANS_UV_DIST4PY (DIR_TRANSAD): spectral vor,div seeds (IN) -> grid u,v (OUT). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2, KGPTOT, KFLD REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(IN) :: PSPVOR, PSPDIV REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(OUT) :: PGPU, PGPV REAL(KIND=JPRB) :: ZVOR(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZDIV(KFLD, KSPEC2) REAL(KIND=JPRB) :: ZGPUV(KGPTOT, KFLD, 2, 1) INTEGER(KIND=JPIM) :: JL #include "dir_transad.h" KRETURNCODE = 0 DO JL = 1, KFLD ZVOR(JL, :) = PSPVOR(:, JL) ZDIV(JL, :) = PSPDIV(:, JL) ENDDO ZGPUV(:,:,:,:) = 0.0_JPRB CALL DIR_TRANSAD(PSPVOR=ZVOR, PSPDIV=ZDIV, PGPUV=ZGPUV, KPROMA=INT(KGPTOT,JPIM)) PGPU(:, :) = ZGPUV(:, :, 1, 1) PGPV(:, :) = ZGPUV(:, :, 2, 1) END SUBROUTINE DIR_TRANS_UV_DIST4PY_AD