! Distributed-memory data movement: scatter a global field (on the 'from' task, ! 1-based MPL rank) to the local partitions, and gather back. Multi-field (KFLD). ! Single precision (JPRB = real32). KFROM/KTO give the source/dest MPL rank per field. SUBROUTINE DIST_SPEC4PY(KRETURNCODE, KSPEC2G, KSPEC2, KFLD, KFROM, PSPECG, PSPEC) ! Global spectral PSPECG(KSPEC2G,KFLD) on KFROM -> local PSPEC(KSPEC2,KFLD). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2G, KSPEC2, KFLD INTEGER(KIND=INT64), DIMENSION(KFLD), INTENT(IN) :: KFROM REAL(KIND=JPRB), DIMENSION(KSPEC2G, KFLD), INTENT(IN) :: PSPECG REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(OUT) :: PSPEC INTEGER(KIND=JPIM) :: IFROM(KFLD) #include "dist_spec.h" KRETURNCODE = 0 IFROM(:) = INT(KFROM(:), JPIM) CALL DIST_SPEC(PSPECG=PSPECG, KFDISTG=INT(KFLD,JPIM), KFROM=IFROM, PSPEC=PSPEC, & & LDIM1_IS_FLD=.FALSE.) END SUBROUTINE DIST_SPEC4PY SUBROUTINE GATH_SPEC4PY(KRETURNCODE, KSPEC2G, KSPEC2, KFLD, KTO, PSPEC, PSPECG) ! Local PSPEC(KSPEC2,KFLD) -> global PSPECG(KSPEC2G,KFLD) on KTO. USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KSPEC2G, KSPEC2, KFLD INTEGER(KIND=INT64), DIMENSION(KFLD), INTENT(IN) :: KTO REAL(KIND=JPRB), DIMENSION(KSPEC2, KFLD), INTENT(IN) :: PSPEC REAL(KIND=JPRB), DIMENSION(KSPEC2G, KFLD), INTENT(OUT) :: PSPECG INTEGER(KIND=JPIM) :: ITO(KFLD) #include "gath_spec.h" KRETURNCODE = 0 ITO(:) = INT(KTO(:), JPIM) PSPECG(:,:) = 0._JPRB CALL GATH_SPEC(PSPECG=PSPECG, KFGATHG=INT(KFLD,JPIM), KTO=ITO, PSPEC=PSPEC, & & LDIM1_IS_FLD=.FALSE.) END SUBROUTINE GATH_SPEC4PY SUBROUTINE DIST_GRID4PY(KRETURNCODE, KGPTOTG, KGPTOT, KFLD, KFROM, PGPG, PGP) ! Global grid PGPG(KGPTOTG,KFLD) on KFROM -> local PGP(KGPTOT,KFLD) (single block). USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KGPTOTG, KGPTOT, KFLD INTEGER(KIND=INT64), DIMENSION(KFLD), INTENT(IN) :: KFROM REAL(KIND=JPRB), DIMENSION(KGPTOTG, KFLD), INTENT(IN) :: PGPG REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(OUT) :: PGP INTEGER(KIND=JPIM) :: IFROM(KFLD) REAL(KIND=JPRB) :: ZGP(KGPTOT, KFLD, 1) #include "dist_grid.h" KRETURNCODE = 0 IFROM(:) = INT(KFROM(:), JPIM) CALL DIST_GRID(PGPG=PGPG, KPROMA=INT(KGPTOT,JPIM), KFDISTG=INT(KFLD,JPIM), KFROM=IFROM, PGP=ZGP) PGP(:,:) = ZGP(:,:,1) END SUBROUTINE DIST_GRID4PY SUBROUTINE GATH_GRID4PY(KRETURNCODE, KGPTOTG, KGPTOT, KFLD, KTO, PGP, PGPG) ! Local PGP(KGPTOT,KFLD) (single block) -> global PGPG(KGPTOTG,KFLD) on KTO. USE ISO_FORTRAN_ENV, ONLY: INT64 USE PARKIND1, ONLY: JPIM, JPRB IMPLICIT NONE INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE INTEGER(KIND=INT64), INTENT(IN) :: KGPTOTG, KGPTOT, KFLD INTEGER(KIND=INT64), DIMENSION(KFLD), INTENT(IN) :: KTO REAL(KIND=JPRB), DIMENSION(KGPTOT, KFLD), INTENT(IN) :: PGP REAL(KIND=JPRB), DIMENSION(KGPTOTG, KFLD), INTENT(OUT) :: PGPG INTEGER(KIND=JPIM) :: ITO(KFLD) REAL(KIND=JPRB) :: ZGP(KGPTOT, KFLD, 1) #include "gath_grid.h" KRETURNCODE = 0 ITO(:) = INT(KTO(:), JPIM) ZGP(:,:,1) = PGP(:,:) PGPG(:,:) = 0._JPRB CALL GATH_GRID(PGPG=PGPG, KPROMA=INT(KGPTOT,JPIM), KFGATHG=INT(KFLD,JPIM), KTO=ITO, PGP=ZGP) END SUBROUTINE GATH_GRID4PY