Spruce up adjoint test a bit

ecmwf-ifs · Mar 7, 2025 · 66a60b0 · 66a60b0
1 parent 1fb5b9a
commit 66a60b0
Showing 1 changed file with 29 additions and 12 deletions.
diff --git a/tests/trans/test_adjoint.F90 b/tests/trans/test_adjoint.F90
@@ -12,14 +12,15 @@ PROGRAM TEST_ADJOINT
 USE PARKIND1,        ONLY: JPIM, JPRB
 USE MPL_MODULE,      ONLY: MPL_INIT, MPL_MYRANK, MPL_NPROC, MPL_BARRIER, MPL_END
 USE ABORT_TRANS_MOD, ONLY: ABORT_TRANS
+
 IMPLICIT NONE
 
 INTEGER(KIND=JPIM) :: NSMAX, NDGL, NPROC, NPRGPNS, NPRGPEW, NPRTRW, NPRTRV
 INTEGER(KIND=JPIM) :: NOUT, NERR, MYPROC, NSPECG, NSPEC2G
 INTEGER(KIND=JPIM) :: NFLEV, NFLEVG
 INTEGER(KIND=JPIM) :: NSPEC2, NGPTOT, NPROMA, NGPBLKS, MYSETV, NUMP
 INTEGER(KIND=JPIM) :: IVSET(1000)
-INTEGER(KIND=JPIM), ALLOCATABLE :: NLOEN(:), ITO(:), MYMS(:), NASM0(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: NLOEN(:), MYMS(:), NASM0(:)
 INTEGER(KIND=JPIM) :: JLEV
 
 REAL(KIND=JPRB) , ALLOCATABLE :: ZSPECX(:,:), ZSPECY(:,:), ZSPECP(:,:)
@@ -29,7 +30,7 @@ PROGRAM TEST_ADJOINT
 REAL(KIND=JPRB) , ALLOCATABLE :: ZSPECYG(:,:), ZSPECXG(:,:)
 REAL(KIND=JPRB) , ALLOCATABLE :: ZRANDSP(:)
 REAL(KIND=JPRB) :: ZSC1, ZSC2, ZRELATIVE_ERROR
-INTEGER(KIND=JPIM) :: JA, JB
+INTEGER(KIND=JPIM) :: JA, JB, I
 LOGICAL :: LUSE_MPI
 
 #include "setup_trans0.h"
@@ -88,11 +89,16 @@ PROGRAM TEST_ADJOINT
 ENDDO
 
 MYSETV = MOD(MYPROC-1,NPRTRV)+1
+
+! Allocate global spectral arrays
 ALLOCATE(ZSPECYG(NFLEVG,NSPEC2G))
 ALLOCATE(ZSPECXG(NFLEVG,NSPEC2G))
+
+! Array for storing random perturbations
 ALLOCATE(ZRANDSP(NSPEC2G))
+
+! Use a full Gaussian grid
 ALLOCATE(NLOEN(NDGL))
-ALLOCATE(ITO(NFLEVG))
 NLOEN(:) = 2*NDGL
 
 ! Initialise ecTrans
@@ -102,22 +108,28 @@ PROGRAM TEST_ADJOINT
 
 CALL TRANS_INQ(KSPEC2=NSPEC2, KGPTOT=NGPTOT, KNUMP=NUMP)
 
+! Get Ms I'm responsible for (MYMS) and spectral packing indices (NASM0)
 ALLOCATE(MYMS(NUMP))
 ALLOCATE(NASM0(0:NSMAX))
-CALL TRANS_INQ(KMYMS=MYMS,KASM0=NASM0)
-NGPBLKS = (NGPTOT-1)/NPROMA+1
+CALL TRANS_INQ(KMYMS=MYMS, KASM0=NASM0)
 
+! Calculate number of NPROMA blocks
+NGPBLKS = (NGPTOT - 1) / NPROMA + 1
+
+! Determine VSET allocation and number of local levels
 NFLEV = 0
-DO JLEV=1,NFLEVG
-  IVSET(JLEV) = MOD(JLEV,NPRTRV)+1
+DO JLEV = 1, NFLEVG
+  IVSET(JLEV) = MOD(JLEV,NPRTRV) + 1
   IF (IVSET(JLEV) == MYSETV) THEN
-    NFLEV = NFLEV+1
+    NFLEV = NFLEV + 1
   ENDIF
 ENDDO
 
+! Local spectral arrays
 ALLOCATE(ZSPECX(NFLEV,NSPEC2))
 ALLOCATE(ZSPECY(NFLEV,NSPEC2))
 ALLOCATE(ZSPECP(NFLEV,NSPEC2))
+
 ALLOCATE(ZVORX(NFLEV,NSPEC2))
 ALLOCATE(ZVORY(NFLEV,NSPEC2))
 ALLOCATE(ZVORP(NFLEV,NSPEC2))
@@ -135,16 +147,20 @@ PROGRAM TEST_ADJOINT
     ZSPECXG(JLEV,:) = (1.0_JPRB-2.0_JPRB*ZRANDSP(:))
   ENDDO
 ENDIF
-ITO(:) = 1
+
+! Initialise vorticity and divergence arrays
 ZVORX = 0.0_JPRB
 ZVORY = 0.0_JPRB
 ZVORP = 0.0_JPRB
 ZDIVX = 0.0_JPRB
 ZDIVY = 0.0_JPRB
 ZDIVP = 0.0_JPRB
 
-CALL DIST_SPEC(PSPECG=ZSPECXG, KFDISTG=NFLEVG, KFROM=ITO, PSPEC=ZSPECX, KVSET=IVSET(1:NFLEVG))
-CALL DIST_SPEC(PSPECG=ZSPECYG, KFDISTG=NFLEVG, KFROM=ITO, PSPEC=ZSPECY, KVSET=IVSET(1:NFLEVG))
+! Distribute global spectral arrays
+CALL DIST_SPEC(PSPECG=ZSPECXG, KFDISTG=NFLEVG, KFROM=(/ (1, I = 1, NFLEVG) /), PSPEC=ZSPECX, &
+  &            KVSET=IVSET(1:NFLEVG))
+CALL DIST_SPEC(PSPECG=ZSPECYG, KFDISTG=NFLEVG, KFROM=(/ (1, I = 1, NFLEVG) /), PSPEC=ZSPECY, &
+  &            KVSET=IVSET(1:NFLEVG))
 
 ! Calculate DIR_TRANS(INV_TRANS(X))
 CALL INV_TRANS(PSPSCALAR=ZSPECX, PSPVOR=ZVORX, PSPDIV=ZDIVX, PGP=ZGX, &
@@ -218,7 +234,8 @@ SUBROUTINE SCALPRODSP(PSP1,PSP2,PSC)
 ENDDO
 !$OMP END PARALLEL DO
 
-CALL GATH_SPEC(PSPECG=ZSPG, KFGATHG=NFLEVG, KTO=ITO, PSPEC=ZSP, KVSET=IVSET(1:NFLEVG))
+CALL GATH_SPEC(PSPECG=ZSPG, KFGATHG=NFLEVG, KTO=(/ (1, I = 1, NFLEVG) /), PSPEC=ZSP, &
+  &            KVSET=IVSET(1:NFLEVG))
 
 IF (MYPROC == 1) THEN
   PSC = SUM(ZSPG)