From 9dc5d02fc77f01aff1abdc638e9b60a77c8db343 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 27 Nov 2025 16:15:26 +0000 Subject: [PATCH 01/14] Remove _PROLOG subroutines --- src/trans/cpu/internal/trgtol_mod.F90 | 81 ++++---------------------- src/trans/cpu/internal/trltog_mod.F90 | 82 ++++----------------------- 2 files changed, 22 insertions(+), 141 deletions(-) diff --git a/src/trans/cpu/internal/trgtol_mod.F90 b/src/trans/cpu/internal/trgtol_mod.F90 index 6f4fd2df7..f54265ec4 100644 --- a/src/trans/cpu/internal/trgtol_mod.F90 +++ b/src/trans/cpu/internal/trgtol_mod.F90 @@ -11,7 +11,7 @@ MODULE TRGTOL_MOD PUBLIC TRGTOL -PRIVATE TRGTOL_PROLOG, TRGTOL_COMM +PRIVATE TRGTOL_COMM CONTAINS @@ -57,7 +57,7 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DISTR ,ONLY : D -USE TRGL_MOD, ONLY : TRGL_BUFFERS, TRGL_VARS +USE TRGL_MOD, ONLY : TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, TRGL_PROLOG, ALLOCATE_BUFFERS_SR IMPLICIT NONE @@ -72,7 +72,7 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP3B(:,:,:,:) REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP2(:,:,:) -TYPE (TRGL_BUFFERS) :: YLCTX +TYPE (TRGL_BUFFERS) :: YDBUFS REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -80,10 +80,15 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& IF (LHOOK) CALL DR_HOOK('TRGTOL',0,ZHOOK_HANDLE) -CALL TRGTOL_PROLOG(KF_FS,KF_GP,KVSET,YLCTX) +YDBUFS%LLTRGTOL = .TRUE. +CALL ALLOCATE_BUFFERS_CST(YDBUFS) +CALL GSTATS(1805, 0) +CALL TRGL_PROLOG(KF_FS, KF_GP, KVSET, YDBUFS) +CALL GSTATS(1805, 1) +CALL ALLOCATE_BUFFERS_SR(YDBUFS, KF_GP) CALL TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YLCTX) + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) IF (LHOOK) CALL DR_HOOK('TRGTOL',1,ZHOOK_HANDLE) @@ -91,72 +96,6 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& END SUBROUTINE TRGTOL -SUBROUTINE TRGTOL_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) - -!**** *TRGTOL_PROLOG * - prolog for transposition of grid point data from column -! structure to latitudinal. Reorganize data between -! grid point calculations and direct Fourier Transform -! the purpose is essentially -! to compute the size of communication buffers in order to enable -! the use of automatic arrays later. - - -! Purpose. -! -------- - - -!** Interface. -! ---------- -! *call* *trgtol_prolog(...) - -! Explicit arguments : -! -------------------- - -! Implicit arguments : -! -------------------- - -! Method. -! ------- -! See documentation - -! Externals. -! ---------- - -! Reference. -! ---------- -! ECMWF Research Department documentation of the IFS - -! Author. -! ------- -! R. El Khatib *Meteo-France* - -! Modifications. -! -------------- -! Original : 18-Aug-2014 from trgtol -! ------------------------------------------------------------------ - -USE PARKIND1 ,ONLY : JPIM - -USE TRGL_MOD ,ONLY : TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, ALLOCATE_BUFFERS_SR, TRGL_PROLOG - -IMPLICIT NONE - -INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_GP -TYPE (TRGL_BUFFERS), INTENT(INOUT) :: YDBUFS -INTEGER(KIND=JPIM),INTENT(IN) :: KVSET(KF_GP) - -! ------------------------------------------------------------------ -!* 0. Some initializations -! -------------------- -YDBUFS%LLTRGTOL = .TRUE. -CALL ALLOCATE_BUFFERS_CST(YDBUFS) -CALL GSTATS(1805,0) -CALL TRGL_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) -CALL GSTATS(1805,1) -CALL ALLOCATE_BUFFERS_SR(YDBUFS, KF_GP) - -END SUBROUTINE TRGTOL_PROLOG - SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) diff --git a/src/trans/cpu/internal/trltog_mod.F90 b/src/trans/cpu/internal/trltog_mod.F90 index 6d31850e5..05b74f04e 100644 --- a/src/trans/cpu/internal/trltog_mod.F90 +++ b/src/trans/cpu/internal/trltog_mod.F90 @@ -14,7 +14,8 @@ MODULE TRLTOG_MOD IMPLICIT NONE -PRIVATE TRLTOG_PROLOG, TRLTOG_COMM +PUBLIC TRLTOG +PRIVATE TRLTOG_COMM CONTAINS @@ -64,7 +65,8 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DISTR ,ONLY : D -USE TRGL_MOD, ONLY : TRGL_BUFFERS +USE TRGL_MOD, ONLY : TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, TRGL_PROLOG, ALLOCATE_BUFFERS_SR + IMPLICIT NONE REAL(KIND=JPRB),INTENT(IN) :: PGLAT(KF_FS,D%NLENGTF) @@ -78,7 +80,7 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP3B(:,:,:,:) REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP2(:,:,:) -TYPE(TRGL_BUFFERS) :: YLCTX +TYPE(TRGL_BUFFERS) :: YDBUFS REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -86,10 +88,15 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& IF (LHOOK) CALL DR_HOOK('TRLTOG',0,ZHOOK_HANDLE) -CALL TRLTOG_PROLOG(KF_FS,KF_GP,KVSET,YLCTX) +YDBUFS%LLTRGTOL = .FALSE. +CALL ALLOCATE_BUFFERS_CST(YDBUFS) +CALL GSTATS(1806, 0) +CALL TRGL_PROLOG(KF_FS, KF_GP, KVSET, YDBUFS) +CALL GSTATS(1806, 1) +CALL ALLOCATE_BUFFERS_SR(YDBUFS, KF_GP) CALL TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YLCTX) + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) IF (LHOOK) CALL DR_HOOK('TRLTOG',1,ZHOOK_HANDLE) @@ -97,71 +104,6 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& END SUBROUTINE TRLTOG -SUBROUTINE TRLTOG_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) - -!**** *TRLTOG_PROLOG * - prolog for transposition of grid point data from latitudinal -! to column structure (this takes place between inverse -! FFT and grid point calculations) : the purpose is essentially -! to compute the size of communication buffers in order to enable -! the use of automatic arrays later. -! TRLTOG_PROLOG is the inverse of TRGTOL_PROLOG - -! Purpose. -! -------- - -!** Interface. -! ---------- -! *call* *TRLTOG_PROLOG(...) - -! Explicit arguments : -! -------------------- -! KVSET - "v-set" for each field (input) - -! Implicit arguments : -! -------------------- - -! Method. -! ------- -! See documentation - -! Externals. -! ---------- - -! Reference. -! ---------- -! ECMWF Research Department documentation of the IFS - -! Author. -! ------- -! R. El Khatib *Meteo-France* - -! Modifications. -! -------------- -! Original : 18-Aug-2014 from trltog -! ------------------------------------------------------------------ - -USE PARKIND1 ,ONLY : JPIM - -USE TRGL_MOD ,ONLY : TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, ALLOCATE_BUFFERS_SR, TRGL_PROLOG - -IMPLICIT NONE - -INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_GP -TYPE (TRGL_BUFFERS), INTENT(INOUT) :: YDBUFS -INTEGER(KIND=JPIM),INTENT(IN) :: KVSET(KF_GP) - -! ------------------------------------------------------------------ -!* 0. Some initializations -! -------------------- -YDBUFS%LLTRGTOL = .FALSE. -CALL ALLOCATE_BUFFERS_CST(YDBUFS) -CALL GSTATS(1806,0) -CALL TRGL_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) -CALL GSTATS(1806,1) -CALL ALLOCATE_BUFFERS_SR(YDBUFS, KF_GP) -END SUBROUTINE TRLTOG_PROLOG - - SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) From 833c83f8d7e54a1ffbd1327cf2b8591796e1c1e1 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 27 Nov 2025 16:15:47 +0000 Subject: [PATCH 02/14] Remove unnecessary import --- src/trans/cpu/internal/trltog_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/trans/cpu/internal/trltog_mod.F90 b/src/trans/cpu/internal/trltog_mod.F90 index 05b74f04e..d21a1ef68 100644 --- a/src/trans/cpu/internal/trltog_mod.F90 +++ b/src/trans/cpu/internal/trltog_mod.F90 @@ -10,8 +10,6 @@ MODULE TRLTOG_MOD -USE PARKIND1, ONLY : JPIM - IMPLICIT NONE PUBLIC TRLTOG From 1e27e13925ff6157995c1cb8ea5fde78509d88fc Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 27 Nov 2025 16:17:15 +0000 Subject: [PATCH 03/14] Add missing IMPLICIT NONE --- src/trans/cpu/internal/trgtol_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/trans/cpu/internal/trgtol_mod.F90 b/src/trans/cpu/internal/trgtol_mod.F90 index f54265ec4..9ab1520ea 100644 --- a/src/trans/cpu/internal/trgtol_mod.F90 +++ b/src/trans/cpu/internal/trgtol_mod.F90 @@ -10,6 +10,8 @@ MODULE TRGTOL_MOD +IMPLICIT NONE + PUBLIC TRGTOL PRIVATE TRGTOL_COMM From 66b8ad1c4fd71598681372d8f9d00837d9c340a8 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 16:29:52 +0000 Subject: [PATCH 04/14] Remove unused imports --- src/trans/cpu/internal/trgtol_mod.F90 | 3 +-- src/trans/cpu/internal/trltog_mod.F90 | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/trans/cpu/internal/trgtol_mod.F90 b/src/trans/cpu/internal/trgtol_mod.F90 index 9ab1520ea..3b30c94f5 100644 --- a/src/trans/cpu/internal/trgtol_mod.F90 +++ b/src/trans/cpu/internal/trgtol_mod.F90 @@ -156,7 +156,7 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! R. El Khatib 09-Sep-2020 64 bits addressing for PGLAT ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIB +USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, JP_NON_BLOCKING_STANDARD, MPL_WAITANY, & @@ -167,7 +167,6 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& & NPRCIDS, MYPROC, NPROC USE TPM_TRANS ,ONLY : LGPNORM -USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS USE TRGL_MOD ,ONLY : TRGL_BUFFERS, TRGL_VARS, & &TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER,& &TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, & diff --git a/src/trans/cpu/internal/trltog_mod.F90 b/src/trans/cpu/internal/trltog_mod.F90 index d21a1ef68..72f803e1c 100644 --- a/src/trans/cpu/internal/trltog_mod.F90 +++ b/src/trans/cpu/internal/trltog_mod.F90 @@ -161,7 +161,7 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! R. El Khatib 09-Sep-2020 64 bits addressing for PGLAT ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIB +USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, JP_NON_BLOCKING_STANDARD, MPL_WAITANY, & @@ -171,7 +171,6 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& USE TPM_DISTR ,ONLY : D, MTAGLG, & & NPRCIDS, MYPROC, NPROC -USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS USE TRGL_MOD ,ONLY : TRGL_BUFFERS, TRGL_VARS, & &TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER,& &TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, & From 878747338f8b2ee7f9b6d957d9ac747494b24cee Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 16:31:55 +0000 Subject: [PATCH 05/14] Remove unused variable --- src/trans/cpu/internal/trgtol_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/trans/cpu/internal/trgtol_mod.F90 b/src/trans/cpu/internal/trgtol_mod.F90 index 3b30c94f5..53bd3c407 100644 --- a/src/trans/cpu/internal/trgtol_mod.F90 +++ b/src/trans/cpu/internal/trgtol_mod.F90 @@ -194,7 +194,6 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! LOCAL INTEGER SCALARS INTEGER(KIND=JPIM) :: IRECV INTEGER(KIND=JPIM) :: ISEND, ITAG, JL, JFLD, INS, INR, JNR -INTEGER(KIND=JPIM) :: IPOS INTEGER(KIND=JPIM) :: II,ILEN INTEGER(KIND=JPIM) :: IRECV_FLD_START,IRECV_FLD_END @@ -340,7 +339,6 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ENDDO ENDDO !$OMP END PARALLEL DO - IPOS = ILEN*(IRECV_FLD_END-IRECV_FLD_START+1) ENDDO IF (NTRANS_SYNC_LEVEL <= 1) THEN From cbd37e93655df198eec7672e3753bcabf5b3bf7c Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 16:41:08 +0000 Subject: [PATCH 06/14] Make minor code styling edits --- src/trans/cpu/internal/trgtol_mod.F90 | 17 ++++++++--------- src/trans/cpu/internal/trltog_mod.F90 | 15 +++++++-------- 2 files changed, 15 insertions(+), 17 deletions(-) diff --git a/src/trans/cpu/internal/trgtol_mod.F90 b/src/trans/cpu/internal/trgtol_mod.F90 index 53bd3c407..a5cab26dd 100644 --- a/src/trans/cpu/internal/trgtol_mod.F90 +++ b/src/trans/cpu/internal/trgtol_mod.F90 @@ -59,7 +59,7 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DISTR ,ONLY : D -USE TRGL_MOD, ONLY : TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, TRGL_PROLOG, ALLOCATE_BUFFERS_SR +USE TRGL_MOD, ONLY: TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, TRGL_PROLOG, ALLOCATE_BUFFERS_SR IMPLICIT NONE @@ -167,10 +167,9 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& & NPRCIDS, MYPROC, NPROC USE TPM_TRANS ,ONLY : LGPNORM -USE TRGL_MOD ,ONLY : TRGL_BUFFERS, TRGL_VARS, & - &TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER,& - &TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, & - &TGRL_COPY_ZCOMBUF, TGRL_COPY_PGLAT, TGRL_INIT_PACKING_VARS +USE TRGL_MOD, ONLY: TRGL_BUFFERS, TRGL_VARS, TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER, & + & TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, TGRL_COPY_ZCOMBUF, TGRL_COPY_PGLAT, & + & TGRL_INIT_PACKING_VARS IMPLICIT NONE @@ -214,15 +213,15 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& !* 0. Some initializations ! -------------------- ASSOCIATE(KNSEND=>YDBUFS%INSEND, KNRECV=>YDBUFS%INRECV, KSENDTOT=>YDBUFS%ISENDTOT, & - & KRECVTOT=>YDBUFS%IRECVTOT, KSEND=>YDBUFS%ISEND, KRECV=>YDBUFS%IRECV, KINDEX=>YDBUFS%IINDEX, & - & KNDOFF=>YDBUFS%INDOFF) + & KRECVTOT=>YDBUFS%IRECVTOT, KSEND=>YDBUFS%ISEND, KRECV=>YDBUFS%IRECV, & + & KINDEX=>YDBUFS%IINDEX, KNDOFF=>YDBUFS%INDOFF) IF (NSTACK_MEMORY_TR == 0) THEN CALL TRGL_ALLOCATE_HEAP_BUFFER(ZCOMBUFS_HEAP, YDBUFS%ISENDCOUNT, YDBUFS%INSEND) CALL TRGL_ALLOCATE_HEAP_BUFFER(ZCOMBUFR_HEAP, YDBUFS%IRECVCOUNT, YDBUFS%INRECV) - ! Now, force the OS to allocate this shared array right now, not when it starts to be used which is - ! an OPEN-MP loop, that would cause a threads synchronization lock : + ! Now, force the OS to allocate this shared array right now, not when it starts to be used which + ! is an OPEN-MP loop, that would cause a threads synchronization lock : IF (YDBUFS%INSEND > 0 .AND. YDBUFS%ISENDCOUNT >=-1) ZCOMBUFS_HEAP(-1,1)=HUGE(1._JPRB) ZCOMBUFS (-1:,1:) => ZCOMBUFS_HEAP ZCOMBUFR (-1:,1:) => ZCOMBUFR_HEAP diff --git a/src/trans/cpu/internal/trltog_mod.F90 b/src/trans/cpu/internal/trltog_mod.F90 index 72f803e1c..75c5a05f9 100644 --- a/src/trans/cpu/internal/trltog_mod.F90 +++ b/src/trans/cpu/internal/trltog_mod.F90 @@ -63,7 +63,7 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DISTR ,ONLY : D -USE TRGL_MOD, ONLY : TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, TRGL_PROLOG, ALLOCATE_BUFFERS_SR +USE TRGL_MOD, ONLY: TRGL_BUFFERS, ALLOCATE_BUFFERS_CST, TRGL_PROLOG, ALLOCATE_BUFFERS_SR IMPLICIT NONE @@ -171,10 +171,9 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& USE TPM_DISTR ,ONLY : D, MTAGLG, & & NPRCIDS, MYPROC, NPROC -USE TRGL_MOD ,ONLY : TRGL_BUFFERS, TRGL_VARS, & - &TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER,& - &TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, & - &TGRL_COPY_ZCOMBUF, TGRL_COPY_PGLAT, TGRL_INIT_PACKING_VARS +USE TRGL_MOD, ONLY: TRGL_BUFFERS, TRGL_VARS, TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER, & + & TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, TGRL_COPY_ZCOMBUF, TGRL_COPY_PGLAT, & + & TGRL_INIT_PACKING_VARS IMPLICIT NONE @@ -219,9 +218,9 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& !* 0. Some initializations ! -------------------- -ASSOCIATE (KSENDCOUNT=>YDBUFS%ISENDCOUNT, KRECVCOUNT=>YDBUFS%IRECVCOUNT, KNSEND=>YDBUFS%INSEND, KNRECV=>YDBUFS%INRECV, & - & KSENDTOT=>YDBUFS%ISENDTOT, KRECVTOT=>YDBUFS%IRECVTOT, KSEND=>YDBUFS%ISEND, KRECV=>YDBUFS%IRECV, KINDEX=>YDBUFS%IINDEX, & - & KNDOFF=>YDBUFS%INDOFF, KGPTRSEND =>YDBUFS%IGPTRSEND, KSETWL=>YDBUFS%ISETWL) +ASSOCIATE(KNSEND=>YDBUFS%INSEND, KNRECV=>YDBUFS%INRECV, KSENDTOT=>YDBUFS%ISENDTOT, & + & KRECVTOT=>YDBUFS%IRECVTOT, KSEND=>YDBUFS%ISEND, KRECV=>YDBUFS%IRECV, & + & KINDEX=>YDBUFS%IINDEX, KNDOFF=>YDBUFS%INDOFF) IF (NSTACK_MEMORY_TR == 0) THEN CALL TRGL_ALLOCATE_HEAP_BUFFER(ZCOMBUFS_HEAP, YDBUFS%ISENDCOUNT, YDBUFS%INSEND) From 38bf861640e32081c9477b878a90ab88a0c44d5f Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 17:22:52 +0000 Subject: [PATCH 07/14] Remove unused associations --- src/trans/cpu/internal/trgl_mod.F90 | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index 5eb412137..b33fb6d15 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -470,11 +470,9 @@ SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS,& LLGP3B=>YLVARS%LLGP3B, IGP3APARS=>YLVARS%IGP3APARS, & IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & IGP3BLEVS=>YLVARS%IGP3BLEVS) - ASSOCIATE (KSENDCOUNT=>YDBUFS%ISENDCOUNT, KRECVCOUNT=>YDBUFS%IRECVCOUNT, KNSEND=>YDBUFS%INSEND, KNRECV=>YDBUFS%INRECV, & - & KSENDTOT=>YDBUFS%ISENDTOT, KRECVTOT=>YDBUFS%IRECVTOT, KSEND=>YDBUFS%ISEND, KRECV=>YDBUFS%IRECV, KINDEX=>YDBUFS%IINDEX, & - & KNDOFF=>YDBUFS%INDOFF, KGPTRSEND =>YDBUFS%IGPTRSEND,& - & IFLDA=>YDBUFS%IFLDA,IPOSPLUS=>YDBUFS%IPOSPLUS, JPOS=>YDBUFS%IJPOS, ISETW=>YDBUFS%ISETW,LLPGPONLY=>YDBUFS%LLPGPONLY, & - & LLINDER=>YDBUFS%LLINDER) + ASSOCIATE(KGPTRSEND =>YDBUFS%IGPTRSEND, IFLDA=>YDBUFS%IFLDA, IPOSPLUS=>YDBUFS%IPOSPLUS, & + & JPOS=>YDBUFS%IJPOS, ISETW=>YDBUFS%ISETW,LLPGPONLY=>YDBUFS%LLPGPONLY, + & LLINDER=>YDBUFS%LLINDER) IPOS=IPOSPLUS(INRS) I_FLD_START = ZCOMBUF(-1,INRS) @@ -580,11 +578,8 @@ SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, & LLGP3B=>YLVARS%LLGP3B, IGP3APARS=>YLVARS%IGP3APARS, & IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & IGP3BLEVS=>YLVARS%IGP3BLEVS) - ASSOCIATE (KSENDCOUNT=>YDBUFS%ISENDCOUNT, KRECVCOUNT=>YDBUFS%IRECVCOUNT, KNSEND=>YDBUFS%INSEND, & - KNRECV=>YDBUFS%INRECV, KSENDTOT=>YDBUFS%ISENDTOT, KRECVTOT=>YDBUFS%IRECVTOT, & - KSEND=>YDBUFS%ISEND, KRECV=>YDBUFS%IRECV, KINDEX=>YDBUFS%IINDEX, KNDOFF=>YDBUFS%INDOFF, & - KGPTRSEND =>YDBUFS%IGPTRSEND,IFLDS=>YDBUFS%IFLDS,LLPGPONLY=>YDBUFS%LLPGPONLY, & - LLINDER=>YDBUFS%LLINDER) + ASSOCIATE(KINDEX=>YDBUFS%IINDEX, KNDOFF=>YDBUFS%INDOFF, KGPTRSEND =>YDBUFS%IGPTRSEND, & + & IFLDS=>YDBUFS%IFLDS,LLPGPONLY=>YDBUFS%LLPGPONLY) #ifdef __NEC__ ! Loops inversion is still better on Aurora machines, according to CHMI. REK. From 032a091790b596fe7ffca2a767e22636cf14cdac Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 17:23:04 +0000 Subject: [PATCH 08/14] Add some nifty vector operation tricks --- src/trans/cpu/internal/trgl_mod.F90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index b33fb6d15..06ac26fff 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -699,11 +699,9 @@ SUBROUTINE TRGL_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) ISETW=YDBUFS%ISETWL(JROC) ISETV=YDBUFS%ISETVL(JROC) -! count up expected number of fields - IPOS = 0 - DO JFLD=1,KF_GP - IF(KVSET(JFLD) == ISETV .OR. KVSET(JFLD) == -1) IPOS = IPOS+1 - ENDDO + + ! Count up expected number of fields + IPOS = COUNT(KVSET == ISETV .OR. KVSET == -1) IF (YDBUFS%LLTRGTOL) THEN YDBUFS%ISENDTOT(JROC) = IGPTRRECV(ISETW)*IPOS @@ -761,12 +759,8 @@ SUBROUTINE TRGL_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) ENDIF ENDDO -YDBUFS%ISENDCOUNT=0 -YDBUFS%IRECVCOUNT=0 -DO J=1,NPROC - YDBUFS%ISENDCOUNT=MAX(YDBUFS%ISENDCOUNT,YDBUFS%ISENDTOT(J)) - YDBUFS%IRECVCOUNT=MAX(YDBUFS%IRECVCOUNT,YDBUFS%IRECVTOT(J)) -ENDDO +YDBUFS%ISENDCOUNT = MAXVAL(YDBUFS%ISENDTOT) +YDBUFS%IRECVCOUNT = MAXVAL(YDBUFS%IRECVTOT) END SUBROUTINE TRGL_PROLOG From 3f23b2da0c5b4172a883a469a74283bccd5dcd98 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 17:24:58 +0000 Subject: [PATCH 09/14] Enforce 100-character line limit --- src/trans/cpu/internal/trgl_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index 06ac26fff..ebae2d34a 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -392,7 +392,8 @@ SUBROUTINE TGRL_INIT_PACKING_VARS(YDBUFS,YLVARS, KVSET, KF_GP, PCOMBUFS) INTEGER(KIND=JPIM) :: IFLD, IPOS, JFLD, IFIRST, ILAST, JBLK INTEGER(KIND=JPIM) :: KINRS, IV, ISETV, INRS - ASSOCIATE (KGPTRSEND =>YDBUFS%IGPTRSEND,IPOSPLUS=>YDBUFS%IPOSPLUS, IJPOS=>YDBUFS%IJPOS, IFLDA=>YDBUFS%IFLDA, ISETW=>YDBUFS%ISETW) + ASSOCIATE(KGPTRSEND=>YDBUFS%IGPTRSEND, IPOSPLUS=>YDBUFS%IPOSPLUS, IJPOS=>YDBUFS%IJPOS, & + & IFLDA=>YDBUFS%IFLDA, ISETW=>YDBUFS%ISETW) IF (YDBUFS%LLTRGTOL) THEN KINRS = YDBUFS%INSEND From e8531dc8865bed52dc5c75d6cbf74096a719a143 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 17:36:40 +0000 Subject: [PATCH 10/14] Remove unnecessary logical locals --- src/trans/cpu/internal/trgl_mod.F90 | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index ebae2d34a..75c8f6431 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -152,7 +152,6 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & REAL(KIND=JPRB),OPTIONAL :: PGP2(:,:,:) ! Local variables - LOGICAL :: LLPGPUV,LLPGP3A,LLPGP3B,LLPGP2 INTEGER(KIND=JPIM) :: IUVPAR,IUVLEV,IGP2PAR,IGP3ALEV,IGP3APAR,IGP3BLEV,IGP3BPAR,IPAROFF INTEGER(KIND=JPIM) :: IOFF,IOFF1,IOFFNS,IOFFEW,J1,J2 @@ -164,15 +163,6 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & LLGP3B=>YLVARS%LLGP3B, IGP3APARS=>YLVARS%IGP3APARS, & IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & IGP3BLEVS=>YLVARS%IGP3BLEVS) - LLPGPUV = .FALSE. - LLPGP3A = .FALSE. - LLPGP3B = .FALSE. - LLPGP2 = .FALSE. - - IF(PRESENT(PGPUV)) LLPGPUV=.TRUE. - IF(PRESENT(PGP3A)) LLPGP3A=.TRUE. - IF(PRESENT(PGP3B)) LLPGP3B=.TRUE. - IF(PRESENT(PGP2)) LLPGP2=.TRUE. IUVPAR=0 IUVLEV=0 @@ -184,7 +174,7 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & IUVPARS(:) = -99 IUVLEVS(:) = -99 - IF (LLPGPUV) THEN + IF (PRESENT(PGPUV)) THEN IOFF=0 IUVLEV=UBOUND(PGPUV,2) IF(LVORGP) THEN @@ -236,7 +226,7 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & ENDIF LLGP2(:)=.FALSE. -IF(LLPGP2) THEN +IF (PRESENT(PGP2)) THEN IOFF=IOFF1 IGP2PAR=UBOUND(PGP2,2) IF(LSCDERS) IGP2PAR=IGP2PAR/3 @@ -262,7 +252,7 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & ENDIF LLGP3A(:) = .FALSE. -IF(LLPGP3A) THEN +IF (PRESENT(PGP3A)) THEN IGP3ALEV=UBOUND(PGP3A,2) IGP3APAR=UBOUND(PGP3A,3) IF(LSCDERS) IGP3APAR=IGP3APAR/3 @@ -300,7 +290,7 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & ENDIF LLGP3B(:) = .FALSE. -IF(LLPGP3B) THEN +IF (PRESENT(PGP3B)) THEN IGP3BLEV=UBOUND(PGP3B,2) IGP3BPAR=UBOUND(PGP3B,3) IF(LSCDERS) IGP3BPAR=IGP3BPAR/3 From 6689010974fda330ed37e37bc763c0bcab002966 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 17:39:17 +0000 Subject: [PATCH 11/14] Fix indentation --- src/trans/cpu/internal/trgl_mod.F90 | 404 ++++++++++++++-------------- 1 file changed, 202 insertions(+), 202 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index 75c8f6431..b74db2d31 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -175,158 +175,158 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & IUVLEVS(:) = -99 IF (PRESENT(PGPUV)) THEN - IOFF=0 - IUVLEV=UBOUND(PGPUV,2) - IF(LVORGP) THEN - IUVPAR=IUVPAR+1 - DO J=1,IUVLEV - IUVLEVS(IOFF+J)=J - IUVPARS(IOFF+J)=IUVPAR - LLUV(IOFF+J)=.TRUE. - ENDDO - IOFF=IOFF+IUVLEV - ENDIF - IF(LDIVGP) THEN - IUVPAR=IUVPAR+1 - DO J=1,IUVLEV - IUVLEVS(IOFF+J)=J - IUVPARS(IOFF+J)=IUVPAR - LLUV(IOFF+J)=.TRUE. - ENDDO - IOFF=IOFF+IUVLEV - ENDIF - DO J=1,IUVLEV - IUVLEVS(IOFF+J)=J - IUVPARS(IOFF+J)=IUVPAR+1 - IUVLEVS(IOFF+J+IUVLEV)=J - IUVPARS(IOFF+J+IUVLEV)=IUVPAR+2 - ENDDO - IUVPAR=IUVPAR+2 - LLUV(IOFF+1:IOFF+2*IUVLEV)=.TRUE. - IOFF=IOFF+2*IUVLEV - IOFF1=IOFF - IOFFNS=IOFFNS+IOFF - IOFFEW=IOFFEW+IOFF - - IOFF=IUVPAR*IUVLEV+KF_SCALARS_G - IF(LUVDER) THEN - IF(LSCDERS) IOFF=IOFF+KF_SCALARS_G + IOFF=0 + IUVLEV=UBOUND(PGPUV,2) + IF(LVORGP) THEN + IUVPAR=IUVPAR+1 + DO J=1,IUVLEV + IUVLEVS(IOFF+J)=J + IUVPARS(IOFF+J)=IUVPAR + LLUV(IOFF+J)=.TRUE. + ENDDO + IOFF=IOFF+IUVLEV + ENDIF + IF(LDIVGP) THEN + IUVPAR=IUVPAR+1 + DO J=1,IUVLEV + IUVLEVS(IOFF+J)=J + IUVPARS(IOFF+J)=IUVPAR + LLUV(IOFF+J)=.TRUE. + ENDDO + IOFF=IOFF+IUVLEV + ENDIF DO J=1,IUVLEV IUVLEVS(IOFF+J)=J IUVPARS(IOFF+J)=IUVPAR+1 - LLUV(IOFF+J)=.TRUE. IUVLEVS(IOFF+J+IUVLEV)=J IUVPARS(IOFF+J+IUVLEV)=IUVPAR+2 - LLUV(IOFF+J+IUVLEV)=.TRUE. ENDDO IUVPAR=IUVPAR+2 + LLUV(IOFF+1:IOFF+2*IUVLEV)=.TRUE. IOFF=IOFF+2*IUVLEV - IOFFEW=IOFFEW+2*IUVLEV + IOFF1=IOFF + IOFFNS=IOFFNS+IOFF + IOFFEW=IOFFEW+IOFF + + IOFF=IUVPAR*IUVLEV+KF_SCALARS_G + IF(LUVDER) THEN + IF(LSCDERS) IOFF=IOFF+KF_SCALARS_G + DO J=1,IUVLEV + IUVLEVS(IOFF+J)=J + IUVPARS(IOFF+J)=IUVPAR+1 + LLUV(IOFF+J)=.TRUE. + IUVLEVS(IOFF+J+IUVLEV)=J + IUVPARS(IOFF+J+IUVLEV)=IUVPAR+2 + LLUV(IOFF+J+IUVLEV)=.TRUE. + ENDDO + IUVPAR=IUVPAR+2 + IOFF=IOFF+2*IUVLEV + IOFFEW=IOFFEW+2*IUVLEV + ENDIF ENDIF -ENDIF - -LLGP2(:)=.FALSE. -IF (PRESENT(PGP2)) THEN - IOFF=IOFF1 - IGP2PAR=UBOUND(PGP2,2) - IF(LSCDERS) IGP2PAR=IGP2PAR/3 - DO J=1,IGP2PAR - LLGP2(J+IOFF) = .TRUE. - IGP2PARS(J+IOFF)=J - ENDDO - IOFF1=IOFF1+IGP2PAR - IF(LSCDERS) THEN - IOFF=IOFFNS - DO J=1,IGP2PAR - LLGP2(J+IOFF) = .TRUE. - IGP2PARS(J+IOFF)=J+IGP2PAR - ENDDO - IOFFNS=IOFF+IGP2PAR - IOFF=IOFFEW + + LLGP2(:)=.FALSE. + IF (PRESENT(PGP2)) THEN + IOFF=IOFF1 + IGP2PAR=UBOUND(PGP2,2) + IF(LSCDERS) IGP2PAR=IGP2PAR/3 DO J=1,IGP2PAR LLGP2(J+IOFF) = .TRUE. - IGP2PARS(J+IOFF)=J+2*IGP2PAR + IGP2PARS(J+IOFF)=J ENDDO - IOFFEW=IOFF+IGP2PAR + IOFF1=IOFF1+IGP2PAR + IF(LSCDERS) THEN + IOFF=IOFFNS + DO J=1,IGP2PAR + LLGP2(J+IOFF) = .TRUE. + IGP2PARS(J+IOFF)=J+IGP2PAR + ENDDO + IOFFNS=IOFF+IGP2PAR + IOFF=IOFFEW + DO J=1,IGP2PAR + LLGP2(J+IOFF) = .TRUE. + IGP2PARS(J+IOFF)=J+2*IGP2PAR + ENDDO + IOFFEW=IOFF+IGP2PAR + ENDIF ENDIF -ENDIF - -LLGP3A(:) = .FALSE. -IF (PRESENT(PGP3A)) THEN - IGP3ALEV=UBOUND(PGP3A,2) - IGP3APAR=UBOUND(PGP3A,3) - IF(LSCDERS) IGP3APAR=IGP3APAR/3 - IOFF=IOFF1 - DO J1=1,IGP3APAR - DO J2=1,IGP3ALEV - LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE. - IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1 - IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2 - ENDDO - ENDDO - IPAROFF=IGP3APAR - IOFF1=IOFF1+IGP3APAR*IGP3ALEV - IF(LSCDERS) THEN - IOFF=IOFFNS + + LLGP3A(:) = .FALSE. + IF (PRESENT(PGP3A)) THEN + IGP3ALEV=UBOUND(PGP3A,2) + IGP3APAR=UBOUND(PGP3A,3) + IF(LSCDERS) IGP3APAR=IGP3APAR/3 + IOFF=IOFF1 DO J1=1,IGP3APAR DO J2=1,IGP3ALEV LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE. - IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1+IPAROFF + IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1 IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2 ENDDO ENDDO - IPAROFF=IPAROFF+IGP3APAR - IOFFNS=IOFFNS+IGP3APAR*IGP3ALEV - IOFF=IOFFEW - DO J1=1,IGP3APAR - DO J2=1,IGP3ALEV - LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE. - IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1+IPAROFF - IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2 + IPAROFF=IGP3APAR + IOFF1=IOFF1+IGP3APAR*IGP3ALEV + IF(LSCDERS) THEN + IOFF=IOFFNS + DO J1=1,IGP3APAR + DO J2=1,IGP3ALEV + LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE. + IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1+IPAROFF + IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2 + ENDDO ENDDO - ENDDO - IOFFEW=IOFFEW+IGP3APAR*IGP3ALEV + IPAROFF=IPAROFF+IGP3APAR + IOFFNS=IOFFNS+IGP3APAR*IGP3ALEV + IOFF=IOFFEW + DO J1=1,IGP3APAR + DO J2=1,IGP3ALEV + LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE. + IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1+IPAROFF + IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2 + ENDDO + ENDDO + IOFFEW=IOFFEW+IGP3APAR*IGP3ALEV + ENDIF ENDIF -ENDIF - -LLGP3B(:) = .FALSE. -IF (PRESENT(PGP3B)) THEN - IGP3BLEV=UBOUND(PGP3B,2) - IGP3BPAR=UBOUND(PGP3B,3) - IF(LSCDERS) IGP3BPAR=IGP3BPAR/3 - IOFF=IOFF1 - DO J1=1,IGP3BPAR - DO J2=1,IGP3BLEV - LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE. - IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1 - IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2 - ENDDO - ENDDO - IPAROFF=IGP3BPAR - IOFF1=IOFF1+IGP3BPAR*IGP3BLEV - IF(LSCDERS) THEN - IOFF=IOFFNS + + LLGP3B(:) = .FALSE. + IF (PRESENT(PGP3B)) THEN + IGP3BLEV=UBOUND(PGP3B,2) + IGP3BPAR=UBOUND(PGP3B,3) + IF(LSCDERS) IGP3BPAR=IGP3BPAR/3 + IOFF=IOFF1 DO J1=1,IGP3BPAR DO J2=1,IGP3BLEV LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE. - IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1+IPAROFF + IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1 IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2 ENDDO ENDDO - IPAROFF=IPAROFF+IGP3BPAR - IOFFNS=IOFFNS+IGP3BPAR*IGP3BLEV - IOFF=IOFFEW - DO J1=1,IGP3BPAR - DO J2=1,IGP3BLEV - LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE. - IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1+IPAROFF - IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2 + IPAROFF=IGP3BPAR + IOFF1=IOFF1+IGP3BPAR*IGP3BLEV + IF(LSCDERS) THEN + IOFF=IOFFNS + DO J1=1,IGP3BPAR + DO J2=1,IGP3BLEV + LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE. + IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1+IPAROFF + IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2 + ENDDO ENDDO - ENDDO - IOFFEW=IOFFEW+IGP3BPAR*IGP3BLEV + IPAROFF=IPAROFF+IGP3BPAR + IOFFNS=IOFFNS+IGP3BPAR*IGP3BLEV + IOFF=IOFFEW + DO J1=1,IGP3BPAR + DO J2=1,IGP3BLEV + LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE. + IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1+IPAROFF + IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2 + ENDDO + ENDDO + IOFFEW=IOFFEW+IGP3BPAR*IGP3BLEV + ENDIF ENDIF -ENDIF -END ASSOCIATE + END ASSOCIATE END SUBROUTINE TRGL_INIT_VARS SUBROUTINE TRGL_INIT_OFF_VARS(YDBUFS,YLVARS,KVSET,KPTRGP,KF_GP) @@ -426,7 +426,7 @@ SUBROUTINE TGRL_INIT_PACKING_VARS(YDBUFS,YLVARS, KVSET, KF_GP, PCOMBUFS) PCOMBUFS(0,INRS) = IFLD ENDIF ENDDO -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO END ASSOCIATE END SUBROUTINE TGRL_INIT_PACKING_VARS @@ -535,8 +535,8 @@ SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS,& ENDDO ENDDO !$OMP END PARALLEL DO -END ASSOCIATE -END ASSOCIATE + END ASSOCIATE + END ASSOCIATE END SUBROUTINE TGRL_COPY_ZCOMBUF @@ -650,108 +650,108 @@ SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, & ENDDO !$OMP END PARALLEL DO -END ASSOCIATE -END ASSOCIATE + END ASSOCIATE + END ASSOCIATE END SUBROUTINE TGRL_COPY_PGLAT SUBROUTINE TRGL_PROLOG(KF_FS,KF_GP,KVSET,YDBUFS) -USE PARKIND1 ,ONLY : JPIM + USE PARKIND1 ,ONLY : JPIM -USE TPM_DISTR ,ONLY : D, MYSETW, NPRTRNS, MYPROC, NPROC + USE TPM_DISTR ,ONLY : D, MYSETW, NPRTRNS, MYPROC, NPROC -USE INIGPTR_MOD ,ONLY : INIGPTR -USE PE2SET_MOD ,ONLY : PE2SET + USE INIGPTR_MOD ,ONLY : INIGPTR + USE PE2SET_MOD ,ONLY : PE2SET -IMPLICIT NONE + IMPLICIT NONE -INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_GP -TYPE (TRGL_BUFFERS), INTENT(INOUT) :: YDBUFS -INTEGER(KIND=JPIM),INTENT(IN) :: KVSET(KF_GP) -INTEGER(KIND=JPIM) :: IGPTRRECV(NPRTRNS) -INTEGER(KIND=JPIM) :: IFIRSTLAT, IGL, IGLL, ILASTLAT, IPOS, ISETA, ISETB, ISETV -INTEGER(KIND=JPIM) :: JFLD, JGL, JL, ISETW, JROC, J -INTEGER(KIND=JPIM) :: INDOFFX + INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_GP + TYPE (TRGL_BUFFERS), INTENT(INOUT) :: YDBUFS + INTEGER(KIND=JPIM),INTENT(IN) :: KVSET(KF_GP) + INTEGER(KIND=JPIM) :: IGPTRRECV(NPRTRNS) + INTEGER(KIND=JPIM) :: IFIRSTLAT, IGL, IGLL, ILASTLAT, IPOS, ISETA, ISETB, ISETV + INTEGER(KIND=JPIM) :: JFLD, JGL, JL, ISETW, JROC, J + INTEGER(KIND=JPIM) :: INDOFFX -! ------------------------------------------------------------------ -!* 0. Some initializations -! -------------------- + ! ------------------------------------------------------------------ + !* 0. Some initializations + ! -------------------- -CALL INIGPTR(YDBUFS%IGPTRSEND,IGPTRRECV) + CALL INIGPTR(YDBUFS%IGPTRSEND,IGPTRRECV) -INDOFFX = 0 -YDBUFS%INRECV = 0 -YDBUFS%INSEND = 0 + INDOFFX = 0 + YDBUFS%INRECV = 0 + YDBUFS%INSEND = 0 -DO JROC=1,NPROC + DO JROC=1,NPROC - CALL PE2SET(JROC,ISETA,ISETB,YDBUFS%ISETWL(JROC),YDBUFS%ISETVL(JROC)) + CALL PE2SET(JROC,ISETA,ISETB,YDBUFS%ISETWL(JROC),YDBUFS%ISETVL(JROC)) - ISETW=YDBUFS%ISETWL(JROC) - ISETV=YDBUFS%ISETVL(JROC) + ISETW=YDBUFS%ISETWL(JROC) + ISETV=YDBUFS%ISETVL(JROC) - ! Count up expected number of fields - IPOS = COUNT(KVSET == ISETV .OR. KVSET == -1) + ! Count up expected number of fields + IPOS = COUNT(KVSET == ISETV .OR. KVSET == -1) - IF (YDBUFS%LLTRGTOL) THEN - YDBUFS%ISENDTOT(JROC) = IGPTRRECV(ISETW)*IPOS - IF( JROC /= MYPROC) THEN - IF(YDBUFS%ISENDTOT(JROC) > 0) THEN - YDBUFS%INSEND = YDBUFS%INSEND+1 - YDBUFS%ISEND(YDBUFS%INSEND)=JROC + IF (YDBUFS%LLTRGTOL) THEN + YDBUFS%ISENDTOT(JROC) = IGPTRRECV(ISETW)*IPOS + IF( JROC /= MYPROC) THEN + IF(YDBUFS%ISENDTOT(JROC) > 0) THEN + YDBUFS%INSEND = YDBUFS%INSEND+1 + YDBUFS%ISEND(YDBUFS%INSEND)=JROC + ENDIF ENDIF - ENDIF - ELSE - YDBUFS%IRECVTOT(JROC) = IGPTRRECV(ISETW)*IPOS - IF(YDBUFS%IRECVTOT(JROC) > 0 .AND. MYPROC /= JROC) THEN - YDBUFS%INRECV = YDBUFS%INRECV + 1 - YDBUFS%IRECV(YDBUFS%INRECV)=JROC - ENDIF - ENDIF - IFIRSTLAT = MAX(D%NPTRLS(MYSETW),D%NFRSTLAT(ISETA)) - ILASTLAT = MIN(D%NPTRLS(MYSETW)+D%NULTPP(MYSETW)-1,D%NLSTLAT(ISETA)) - - IPOS = 0 - DO JGL=IFIRSTLAT,ILASTLAT - IGL = D%NPTRFRSTLAT(ISETA)+JGL-D%NFRSTLAT(ISETA) - IPOS = IPOS+D%NONL(IGL,ISETB) - ENDDO - - IF (YDBUFS%LLTRGTOL) THEN - YDBUFS%IRECVTOT(JROC) = IPOS*KF_FS - IF(YDBUFS%IRECVTOT(JROC) > 0 .AND. MYPROC /= JROC) THEN - YDBUFS%INRECV = YDBUFS%INRECV + 1 - YDBUFS%IRECV(YDBUFS%INRECV)=JROC - ENDIF - ELSE - YDBUFS%ISENDTOT(JROC) = IPOS*KF_FS - IF( JROC /= MYPROC) THEN - IF(YDBUFS%ISENDTOT(JROC) > 0) THEN - YDBUFS%INSEND = YDBUFS%INSEND+1 - YDBUFS%ISEND(YDBUFS%INSEND)=JROC + ELSE + YDBUFS%IRECVTOT(JROC) = IGPTRRECV(ISETW)*IPOS + IF(YDBUFS%IRECVTOT(JROC) > 0 .AND. MYPROC /= JROC) THEN + YDBUFS%INRECV = YDBUFS%INRECV + 1 + YDBUFS%IRECV(YDBUFS%INRECV)=JROC ENDIF ENDIF - ENDIF + IFIRSTLAT = MAX(D%NPTRLS(MYSETW),D%NFRSTLAT(ISETA)) + ILASTLAT = MIN(D%NPTRLS(MYSETW)+D%NULTPP(MYSETW)-1,D%NLSTLAT(ISETA)) - IF(IPOS > 0) THEN - YDBUFS%INDOFF(JROC) = INDOFFX - INDOFFX = INDOFFX+IPOS IPOS = 0 DO JGL=IFIRSTLAT,ILASTLAT IGL = D%NPTRFRSTLAT(ISETA)+JGL-D%NFRSTLAT(ISETA) - IGLL = JGL-D%NPTRLS(MYSETW)+1 - DO JL=D%NSTA(IGL,ISETB)+D%NSTAGTF(IGLL),& - &D%NSTA(IGL,ISETB)+D%NSTAGTF(IGLL)+D%NONL(IGL,ISETB)-1 - IPOS = IPOS+1 - YDBUFS%IINDEX(IPOS+YDBUFS%INDOFF(JROC)) = JL - ENDDO + IPOS = IPOS+D%NONL(IGL,ISETB) ENDDO - ENDIF -ENDDO -YDBUFS%ISENDCOUNT = MAXVAL(YDBUFS%ISENDTOT) -YDBUFS%IRECVCOUNT = MAXVAL(YDBUFS%IRECVTOT) + IF (YDBUFS%LLTRGTOL) THEN + YDBUFS%IRECVTOT(JROC) = IPOS*KF_FS + IF(YDBUFS%IRECVTOT(JROC) > 0 .AND. MYPROC /= JROC) THEN + YDBUFS%INRECV = YDBUFS%INRECV + 1 + YDBUFS%IRECV(YDBUFS%INRECV)=JROC + ENDIF + ELSE + YDBUFS%ISENDTOT(JROC) = IPOS*KF_FS + IF( JROC /= MYPROC) THEN + IF(YDBUFS%ISENDTOT(JROC) > 0) THEN + YDBUFS%INSEND = YDBUFS%INSEND+1 + YDBUFS%ISEND(YDBUFS%INSEND)=JROC + ENDIF + ENDIF + ENDIF + + IF(IPOS > 0) THEN + YDBUFS%INDOFF(JROC) = INDOFFX + INDOFFX = INDOFFX+IPOS + IPOS = 0 + DO JGL=IFIRSTLAT,ILASTLAT + IGL = D%NPTRFRSTLAT(ISETA)+JGL-D%NFRSTLAT(ISETA) + IGLL = JGL-D%NPTRLS(MYSETW)+1 + DO JL=D%NSTA(IGL,ISETB)+D%NSTAGTF(IGLL),& + &D%NSTA(IGL,ISETB)+D%NSTAGTF(IGLL)+D%NONL(IGL,ISETB)-1 + IPOS = IPOS+1 + YDBUFS%IINDEX(IPOS+YDBUFS%INDOFF(JROC)) = JL + ENDDO + ENDDO + ENDIF + ENDDO + + YDBUFS%ISENDCOUNT = MAXVAL(YDBUFS%ISENDTOT) + YDBUFS%IRECVCOUNT = MAXVAL(YDBUFS%IRECVTOT) END SUBROUTINE TRGL_PROLOG From b37afac7687e4b9a3a3f6c232df1dde952ff5171 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 4 Dec 2025 17:55:17 +0000 Subject: [PATCH 12/14] Make use of line continuation more consistent - Lines can be up to 100 characters - Always two continuation characters - One indentation on the next line before the character --- src/trans/cpu/internal/trgl_mod.F90 | 47 +++++++++---------------- src/trans/cpu/internal/trgtol_mod.F90 | 50 +++++++++++---------------- src/trans/cpu/internal/trltog_mod.F90 | 50 +++++++++++---------------- 3 files changed, 59 insertions(+), 88 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index b74db2d31..7042a6395 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -137,8 +137,7 @@ SUBROUTINE TRGL_ALLOCATE_HEAP_BUFFER(Z_HEAP, S1, S2) END SUBROUTINE TRGL_ALLOCATE_HEAP_BUFFER -SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & - & PGP, PGPUV, PGP3A, PGP3B, PGP2) +SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, PGP, PGPUV, PGP3A, PGP3B, PGP2) USE PARKIND1 ,ONLY : JPIM, JPRB USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP IMPLICIT NONE @@ -157,12 +156,10 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, & INTEGER(KIND=JPIM) :: J - ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS, IUVPARS=>YLVARS%IUVPARS, & - IGP2PARS=>YLVARS%IGP2PARS, LLUV=>YLVARS%LLUV, & - LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, & - LLGP3B=>YLVARS%LLGP3B, IGP3APARS=>YLVARS%IGP3APARS, & - IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & - IGP3BLEVS=>YLVARS%IGP3BLEVS) + ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS, IUVPARS=>YLVARS%IUVPARS, IGP2PARS=>YLVARS%IGP2PARS, & + & LLUV=>YLVARS%LLUV, LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, LLGP3B=>YLVARS%LLGP3B, & + & IGP3APARS=>YLVARS%IGP3APARS, IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & + & IGP3BLEVS=>YLVARS%IGP3BLEVS) IUVPAR=0 IUVLEV=0 @@ -391,8 +388,7 @@ SUBROUTINE TGRL_INIT_PACKING_VARS(YDBUFS,YLVARS, KVSET, KF_GP, PCOMBUFS) KINRS = YDBUFS%INRECV ENDIF - !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(INRS,IV,ISETV,JBLK,IFIRST,ILAST,& - !$OMP& IFLD,IPOS,JFLD) + !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(INRS, IV, ISETV, JBLK, IFIRST, ILAST, IFLD, IPOS, JFLD) DO INRS=1,KINRS IF (YDBUFS%LLTRGTOL) THEN IV=YDBUFS%ISEND(INRS) @@ -431,10 +427,7 @@ SUBROUTINE TGRL_INIT_PACKING_VARS(YDBUFS,YLVARS, KVSET, KF_GP, PCOMBUFS) END ASSOCIATE END SUBROUTINE TGRL_INIT_PACKING_VARS -SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS,& - & ZCOMBUF, & - & KPTRGP,& - & PGP, PGPUV, PGP3A, PGP3B, PGP2) +SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS, ZCOMBUF, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2) USE PARKIND1 ,ONLY : JPIM, JPRB USE TPM_TRANS ,ONLY : NGPBLKS @@ -455,12 +448,10 @@ SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS,& INTEGER(KIND=JPIM) :: IFIRST, ILAST INTEGER(KIND=JPIM) :: JJ,JI,JK,IFLDT, JBLK, IPOS - ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS, IUVPARS=>YLVARS%IUVPARS, & - IGP2PARS=>YLVARS%IGP2PARS, LLUV=>YLVARS%LLUV, & - LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, & - LLGP3B=>YLVARS%LLGP3B, IGP3APARS=>YLVARS%IGP3APARS, & - IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & - IGP3BLEVS=>YLVARS%IGP3BLEVS) + ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS, IUVPARS=>YLVARS%IUVPARS, IGP2PARS=>YLVARS%IGP2PARS, & + & LLUV=>YLVARS%LLUV, LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, LLGP3B=>YLVARS%LLGP3B, & + & IGP3APARS=>YLVARS%IGP3APARS, IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & + & IGP3BLEVS=>YLVARS%IGP3BLEVS) ASSOCIATE(KGPTRSEND =>YDBUFS%IGPTRSEND, IFLDA=>YDBUFS%IFLDA, IPOSPLUS=>YDBUFS%IPOSPLUS, & & JPOS=>YDBUFS%IJPOS, ISETW=>YDBUFS%ISETW,LLPGPONLY=>YDBUFS%LLPGPONLY, & LLINDER=>YDBUFS%LLINDER) @@ -540,8 +531,7 @@ SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS,& END SUBROUTINE TGRL_COPY_ZCOMBUF -SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, & - & PGP, PGPUV, PGP3A, PGP3B, PGP2) +SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, PGP, PGPUV, PGP3A, PGP3B, PGP2) USE PARKIND1 ,ONLY : JPIM, JPRB, JPIB USE TPM_DISTR ,ONLY : MYSETW, MYPROC @@ -561,14 +551,11 @@ SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, & !Local variables INTEGER(KIND=JPIM) :: IFIRST, ILAST, IFLD, IPOS, JBLK, JK INTEGER(KIND=JPIB) :: JFLD64 - ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS,IFLDOFF=>YLVARS%IFLDOFF,& - IGPTROFF=>YLVARS%IGPTROFF,& - IUVPARS=>YLVARS%IUVPARS, & - IGP2PARS=>YLVARS%IGP2PARS, LLUV=>YLVARS%LLUV, & - LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, & - LLGP3B=>YLVARS%LLGP3B, IGP3APARS=>YLVARS%IGP3APARS, & - IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & - IGP3BLEVS=>YLVARS%IGP3BLEVS) + ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS,IFLDOFF=>YLVARS%IFLDOFF, IGPTROFF=>YLVARS%IGPTROFF, & + & IUVPARS=>YLVARS%IUVPARS, IGP2PARS=>YLVARS%IGP2PARS, LLUV=>YLVARS%LLUV, & + & LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, LLGP3B=>YLVARS%LLGP3B, & + & IGP3APARS=>YLVARS%IGP3APARS, IGP3ALEVS=>YLVARS%IGP3ALEVS, & + & IGP3BPARS=>YLVARS%IGP3BPARS, IGP3BLEVS=>YLVARS%IGP3BLEVS) ASSOCIATE(KINDEX=>YDBUFS%IINDEX, KNDOFF=>YDBUFS%INDOFF, KGPTRSEND =>YDBUFS%IGPTRSEND, & & IFLDS=>YDBUFS%IFLDS,LLPGPONLY=>YDBUFS%LLPGPONLY) diff --git a/src/trans/cpu/internal/trgtol_mod.F90 b/src/trans/cpu/internal/trgtol_mod.F90 index a5cab26dd..acc44418a 100644 --- a/src/trans/cpu/internal/trgtol_mod.F90 +++ b/src/trans/cpu/internal/trgtol_mod.F90 @@ -17,8 +17,7 @@ MODULE TRGTOL_MOD CONTAINS -SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& - &PGP,PGPUV,PGP3A,PGP3B,PGP2) +SUBROUTINE TRGTOL(PGLAT, KF_FS, KF_GP, KF_SCALARS_G, KVSET, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2) !**** *TRGTOL * - head routine for transposition of grid point data from column ! structure to latitudinal. Reorganize data between @@ -89,8 +88,8 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& CALL GSTATS(1805, 1) CALL ALLOCATE_BUFFERS_SR(YDBUFS, KF_GP) -CALL TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) +CALL TRGTOL_COMM(PGLAT, KF_FS, KF_GP, KF_SCALARS_G, KVSET, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2, & + & YDBUFS) IF (LHOOK) CALL DR_HOOK('TRGTOL',1,ZHOOK_HANDLE) @@ -98,8 +97,8 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& END SUBROUTINE TRGTOL -SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) +SUBROUTINE TRGTOL_COMM(PGLAT, KF_FS, KF_GP, KF_SCALARS_G, KVSET, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, & + & PGP2,YDBUFS) !**** *TRGTOL_COMM * - transposition of grid point data from column ! structure to latitudinal. Reorganize data between @@ -160,11 +159,10 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, JP_NON_BLOCKING_STANDARD, MPL_WAITANY, & - & JP_BLOCKING_STANDARD, MPL_BARRIER, JP_BLOCKING_BUFFERED + & JP_BLOCKING_STANDARD, MPL_BARRIER, JP_BLOCKING_BUFFERED USE TPM_GEN ,ONLY : NTRANS_SYNC_LEVEL, NSTACK_MEMORY_TR -USE TPM_DISTR ,ONLY : D, MTAGGL, & - & NPRCIDS, MYPROC, NPROC +USE TPM_DISTR ,ONLY : D, MTAGGL, NPRCIDS, MYPROC, NPROC USE TPM_TRANS ,ONLY : LGPNORM USE TRGL_MOD, ONLY: TRGL_BUFFERS, TRGL_VARS, TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER, & @@ -246,10 +244,9 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& !...Receive loop......................................................... DO INR=1,KNRECV IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & - & KSOURCE=NPRCIDS(IRECV), & - & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_RECV(INR), & - & KTAG=ITAG,CDSTRING='TRGTOL_COMM: NON-BLOCKING IRECV' ) + CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), KSOURCE=NPRCIDS(IRECV), & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD, KREQUEST=IREQ_RECV(INR), KTAG=ITAG, & + & CDSTRING='TRGTOL_COMM: NON-BLOCKING IRECV' ) ENDDO ENDIF @@ -290,23 +287,20 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& DO INS=1,KNSEND - CALL TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INS, & - & ZCOMBUFS, & - & KPTRGP, & - PGP, PGPUV, PGP3A, PGP3B, PGP2) + CALL TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INS, ZCOMBUFS, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2) ENDDO DO INS=1,KNSEND ISEND=KSEND(INS) IF (NTRANS_SYNC_LEVEL <= 1) THEN - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& - & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_SEND(INS), & - & KTAG=ITAG,CDSTRING='TRGTOL_COMM: NON-BLOCKING ISEND') + CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND), & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD, KREQUEST=IREQ_SEND(INS), KTAG=ITAG, & + & CDSTRING='TRGTOL_COMM: NON-BLOCKING ISEND') ELSE - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& - & KMP_TYPE=JP_BLOCKING_BUFFERED, & - & KTAG=ITAG,CDSTRING='TRGTOL_COMM: BLOCKING BUFFERED BSEND') + CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS), KDEST=NPRCIDS(ISEND), & + & KMP_TYPE=JP_BLOCKING_BUFFERED, KTAG=ITAG, & + & CDSTRING='TRGTOL_COMM: BLOCKING BUFFERED BSEND') ENDIF ENDDO @@ -315,15 +309,13 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& DO JNR=1,KNRECV IF (NTRANS_SYNC_LEVEL <= 0) THEN - CALL MPL_WAITANY(KREQUEST=IREQ_RECV(1:KNRECV),KINDEX=INR,& - & CDSTRING='TRGTOL_COMM: WAIT FOR ANY RECEIVES') + CALL MPL_WAITANY(KREQUEST=IREQ_RECV(1:KNRECV), KINDEX=INR, & + & CDSTRING='TRGTOL_COMM: WAIT FOR ANY RECEIVES') ELSE INR = JNR IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & - & KSOURCE=NPRCIDS(IRECV), & - & KMP_TYPE=JP_BLOCKING_STANDARD, & - & KTAG=ITAG,CDSTRING='TRGTOL_COMM: BLOCKING RECV' ) + CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), KSOURCE=NPRCIDS(IRECV), & + & KMP_TYPE=JP_BLOCKING_STANDARD, KTAG=ITAG, CDSTRING='TRGTOL_COMM: BLOCKING RECV' ) ENDIF IRECV=KRECV(INR) diff --git a/src/trans/cpu/internal/trltog_mod.F90 b/src/trans/cpu/internal/trltog_mod.F90 index 75c5a05f9..bf0c43f37 100644 --- a/src/trans/cpu/internal/trltog_mod.F90 +++ b/src/trans/cpu/internal/trltog_mod.F90 @@ -17,8 +17,7 @@ MODULE TRLTOG_MOD CONTAINS -SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& - &PGP,PGPUV,PGP3A,PGP3B,PGP2) +SUBROUTINE TRLTOG(PGLAT, KF_FS, KF_GP, KF_SCALARS_G, KVSET, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2) !**** *TRLTOG * - head routine for transposition of grid point data from latitudinal ! to column structure (this takes place between inverse @@ -93,8 +92,8 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& CALL GSTATS(1806, 1) CALL ALLOCATE_BUFFERS_SR(YDBUFS, KF_GP) -CALL TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) +CALL TRLTOG_COMM(PGLAT, KF_FS, KF_GP, KF_SCALARS_G, KVSET, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2, & + & YDBUFS) IF (LHOOK) CALL DR_HOOK('TRLTOG',1,ZHOOK_HANDLE) @@ -102,8 +101,8 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& END SUBROUTINE TRLTOG -SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,YDBUFS) +SUBROUTINE TRLTOG_COMM(PGLAT, KF_FS, KF_GP, KF_SCALARS_G, KVSET, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, & + & PGP2,YDBUFS) !**** *trltog * - transposition of grid point data from latitudinal @@ -165,11 +164,10 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, JP_NON_BLOCKING_STANDARD, MPL_WAITANY, & - & JP_BLOCKING_STANDARD, MPL_BARRIER, JP_BLOCKING_BUFFERED + & JP_BLOCKING_STANDARD, MPL_BARRIER, JP_BLOCKING_BUFFERED USE TPM_GEN ,ONLY : NTRANS_SYNC_LEVEL, NSTACK_MEMORY_TR -USE TPM_DISTR ,ONLY : D, MTAGLG, & - & NPRCIDS, MYPROC, NPROC +USE TPM_DISTR ,ONLY : D, MTAGLG, NPRCIDS, MYPROC, NPROC USE TRGL_MOD, ONLY: TRGL_BUFFERS, TRGL_VARS, TRGL_ALLOCATE_VARS, TRGL_ALLOCATE_HEAP_BUFFER, & & TRGL_INIT_VARS, TRGL_INIT_OFF_VARS, TGRL_COPY_ZCOMBUF, TGRL_COPY_PGLAT, & @@ -248,10 +246,9 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& !...Receive loop......................................................... DO INR=1,KNRECV IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & - & KSOURCE=NPRCIDS(IRECV), & - & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_RECV(INR), & - & KTAG=ITAG,CDSTRING='TRLTOG_COMM: NON-BLOCKING IRECV' ) + CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), KSOURCE=NPRCIDS(IRECV), & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD, KREQUEST=IREQ_RECV(INR), KTAG=ITAG, & + & CDSTRING='TRLTOG_COMM: NON-BLOCKING IRECV' ) ENDDO ENDIF @@ -299,13 +296,13 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ZCOMBUFS(-1,INS) = 1 ZCOMBUFS(0,INS) = KF_FS IF (NTRANS_SYNC_LEVEL <= 1) THEN - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& - & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_SEND(INS), & - & KTAG=ITAG,CDSTRING='TRLTOG_COMM: NON-BLOCKING ISEND') + CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS), KDEST=NPRCIDS(ISEND), & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD, KREQUEST=IREQ_SEND(INS), KTAG=ITAG, & + & CDSTRING='TRLTOG_COMM: NON-BLOCKING ISEND') ELSE - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& - & KMP_TYPE=JP_BLOCKING_BUFFERED, & - & KTAG=ITAG,CDSTRING='TRLTOG_COMM: BLOCKING BUFFERED BSEND') + CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS), KDEST=NPRCIDS(ISEND), & + & KMP_TYPE=JP_BLOCKING_BUFFERED, KTAG=ITAG, & + & CDSTRING='TRLTOG_COMM: BLOCKING BUFFERED BSEND') ENDIF ENDDO @@ -316,21 +313,16 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& DO JNR=1,KNRECV IF (NTRANS_SYNC_LEVEL <= 0) THEN - CALL MPL_WAITANY(KREQUEST=IREQ_RECV(1:KNRECV),KINDEX=INR,& - & CDSTRING='TRLTOG_COMM: WAIT FOR ANY RECEIVES') + CALL MPL_WAITANY(KREQUEST=IREQ_RECV(1:KNRECV), KINDEX=INR, & + & CDSTRING='TRLTOG_COMM: WAIT FOR ANY RECEIVES') ELSE INR = JNR IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & - & KSOURCE=NPRCIDS(IRECV), & - & KMP_TYPE=JP_BLOCKING_STANDARD, & - & KTAG=ITAG,CDSTRING='TRLTOG_COMM: BLOCKING RECV' ) + CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), KSOURCE=NPRCIDS(IRECV), & + & KMP_TYPE=JP_BLOCKING_STANDARD, KTAG=ITAG, CDSTRING='TRLTOG_COMM: BLOCKING RECV') ENDIF - CALL TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INR, & - & ZCOMBUFR, & - & KPTRGP, & - & PGP, PGPUV, PGP3A, PGP3B, PGP2) + CALL TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INR, ZCOMBUFR, KPTRGP, PGP, PGPUV, PGP3A, PGP3B, PGP2) ENDDO IF (NTRANS_SYNC_LEVEL <= 1) THEN From 6908023e7e04938566fab3ecb3464aedbd6c17d8 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Fri, 5 Dec 2025 08:51:12 +0000 Subject: [PATCH 13/14] Tidy up ASSOCIATEs --- src/trans/cpu/internal/trgl_mod.F90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index 7042a6395..892553da8 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -323,6 +323,7 @@ SUBROUTINE TRGL_INIT_VARS(YLVARS, KF_SCALARS_G, PGP, PGPUV, PGP3A, PGP3B, PGP2) IOFFEW=IOFFEW+IGP3BPAR*IGP3BLEV ENDIF ENDIF + END ASSOCIATE END SUBROUTINE TRGL_INIT_VARS @@ -339,8 +340,9 @@ SUBROUTINE TRGL_INIT_OFF_VARS(YDBUFS,YLVARS,KVSET,KPTRGP,KF_GP) !local variables INTEGER(KIND=JPIM) :: JFLD, IFIRST, ILAST,IPOS, JBLK - ASSOCIATE(KGPTRSEND =>YDBUFS%IGPTRSEND,IFLDS=>YDBUFS%IFLDS) - ASSOCIATE(IFLDOFF=>YLVARS%IFLDOFF, IGPTROFF=>YLVARS%IGPTROFF, LLINDER=>YDBUFS%LLINDER) + ASSOCIATE(KGPTRSEND=>YDBUFS%IGPTRSEND, IFLDS=>YDBUFS%IFLDS, IFLDOFF=>YLVARS%IFLDOFF, & + & IGPTROFF=>YLVARS%IGPTROFF, LLINDER=>YDBUFS%LLINDER) + IFLDS = 0 DO JFLD=1,KF_GP IF(KVSET(JFLD) == MYSETV .OR. KVSET(JFLD) == -1) THEN @@ -362,7 +364,7 @@ SUBROUTINE TRGL_INIT_OFF_VARS(YDBUFS,YLVARS,KVSET,KPTRGP,KF_GP) IPOS=IPOS+ILAST-IFIRST+1 ENDIF ENDDO - END ASSOCIATE + END ASSOCIATE END SUBROUTINE TRGL_INIT_OFF_VARS @@ -451,10 +453,9 @@ SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS, ZCOMBUF, KPTRGP, PGP, PGPUV, ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS, IUVPARS=>YLVARS%IUVPARS, IGP2PARS=>YLVARS%IGP2PARS, & & LLUV=>YLVARS%LLUV, LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, LLGP3B=>YLVARS%LLGP3B, & & IGP3APARS=>YLVARS%IGP3APARS, IGP3ALEVS=>YLVARS%IGP3ALEVS, IGP3BPARS=>YLVARS%IGP3BPARS, & - & IGP3BLEVS=>YLVARS%IGP3BLEVS) - ASSOCIATE(KGPTRSEND =>YDBUFS%IGPTRSEND, IFLDA=>YDBUFS%IFLDA, IPOSPLUS=>YDBUFS%IPOSPLUS, & - & JPOS=>YDBUFS%IJPOS, ISETW=>YDBUFS%ISETW,LLPGPONLY=>YDBUFS%LLPGPONLY, - & LLINDER=>YDBUFS%LLINDER) + & IGP3BLEVS=>YLVARS%IGP3BLEVS, KGPTRSEND =>YDBUFS%IGPTRSEND, IFLDA=>YDBUFS%IFLDA, & + & IPOSPLUS=>YDBUFS%IPOSPLUS, JPOS=>YDBUFS%IJPOS, ISETW=>YDBUFS%ISETW, & + & LLPGPONLY=>YDBUFS%LLPGPONLY, LLINDER=>YDBUFS%LLINDER) IPOS=IPOSPLUS(INRS) I_FLD_START = ZCOMBUF(-1,INRS) @@ -526,7 +527,7 @@ SUBROUTINE TGRL_COPY_ZCOMBUF(YDBUFS, YLVARS, INRS, ZCOMBUF, KPTRGP, PGP, PGPUV, ENDDO ENDDO !$OMP END PARALLEL DO - END ASSOCIATE + END ASSOCIATE END SUBROUTINE TGRL_COPY_ZCOMBUF @@ -551,13 +552,14 @@ SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, PGP, PGPUV, PGP3A, PGP3B, PGP2 !Local variables INTEGER(KIND=JPIM) :: IFIRST, ILAST, IFLD, IPOS, JBLK, JK INTEGER(KIND=JPIB) :: JFLD64 + ASSOCIATE(IUVLEVS=>YLVARS%IUVLEVS,IFLDOFF=>YLVARS%IFLDOFF, IGPTROFF=>YLVARS%IGPTROFF, & & IUVPARS=>YLVARS%IUVPARS, IGP2PARS=>YLVARS%IGP2PARS, LLUV=>YLVARS%LLUV, & & LLGP2=>YLVARS%LLGP2, LLGP3A=>YLVARS%LLGP3A, LLGP3B=>YLVARS%LLGP3B, & & IGP3APARS=>YLVARS%IGP3APARS, IGP3ALEVS=>YLVARS%IGP3ALEVS, & - & IGP3BPARS=>YLVARS%IGP3BPARS, IGP3BLEVS=>YLVARS%IGP3BLEVS) - ASSOCIATE(KINDEX=>YDBUFS%IINDEX, KNDOFF=>YDBUFS%INDOFF, KGPTRSEND =>YDBUFS%IGPTRSEND, & - & IFLDS=>YDBUFS%IFLDS,LLPGPONLY=>YDBUFS%LLPGPONLY) + & IGP3BPARS=>YLVARS%IGP3BPARS, IGP3BLEVS=>YLVARS%IGP3BLEVS, KINDEX=>YDBUFS%IINDEX, & + & KNDOFF=>YDBUFS%INDOFF, KGPTRSEND =>YDBUFS%IGPTRSEND, IFLDS=>YDBUFS%IFLDS, & + & LLPGPONLY=>YDBUFS%LLPGPONLY) #ifdef __NEC__ ! Loops inversion is still better on Aurora machines, according to CHMI. REK. @@ -638,7 +640,6 @@ SUBROUTINE TGRL_COPY_PGLAT(PGLAT, YDBUFS, YLVARS, PGP, PGPUV, PGP3A, PGP3B, PGP2 !$OMP END PARALLEL DO END ASSOCIATE - END ASSOCIATE END SUBROUTINE TGRL_COPY_PGLAT From d2dcc54720ca339208e48f2e4ea098dddcba4758 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Fri, 5 Dec 2025 08:51:44 +0000 Subject: [PATCH 14/14] Update copyrights --- src/trans/cpu/internal/trgl_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/trans/cpu/internal/trgl_mod.F90 b/src/trans/cpu/internal/trgl_mod.F90 index 892553da8..c41d0972b 100644 --- a/src/trans/cpu/internal/trgl_mod.F90 +++ b/src/trans/cpu/internal/trgl_mod.F90 @@ -1,5 +1,5 @@ -! (C) Copyright 1995- ECMWF. -! (C) Copyright 1995- Meteo-France. +! (C) Copyright 2025- ECMWF. +! (C) Copyright 2025- Meteo-France. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.