! (C) Copyright 2000- ECMWF. ! (C) Copyright 2000- Meteo-France. ! (C) Copyright 2022- NVIDIA. ! ! 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. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. ! MODULE INIGPTR_MOD CONTAINS SUBROUTINE INIGPTR(KGPTRSEND,KGPTRRECV) ! Compute tables to assist GP to/from Fourier space transpositions USE PARKIND1 ,ONLY : JPIM ,JPRB USE TPM_GEN ,ONLY : NOUT USE TPM_DISTR ,ONLY : D, NPRTRNS USE TPM_TRANS ,ONLY : NGPBLKS, NPROMA USE EQ_REGIONS_MOD ,ONLY : MY_REGION_EW USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS ! IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(OUT) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) INTEGER(KIND=JPIM),INTENT(OUT) :: KGPTRRECV(NPRTRNS) INTEGER(KIND=JPIM) :: IBLOCK,IROF,IBFIRST,IPROCLAST,IPROC,IFIRST,ILAST,IBLAST INTEGER(KIND=JPIM) :: JGL,JBL,JPRTRNS,JBLKS ! Compute tables to assist GP to/from Fourier space transpositions KGPTRSEND(1,:,:)=0 KGPTRSEND(2,:,:)=-1 IBLOCK=1 IROF=1 IBFIRST=1 IPROCLAST=D%NPROCL(D%NFRSTLOFF+1) ! for each latitude on this processor DO JGL=1,D%NDGL_GP ! find the processor where this row should be saved in the fourier distribution ! this is called the "w-set" IPROC=D%NPROCL(D%NFRSTLOFF+JGL) ! for each latitude on this processor, find first and last points ! for each NPROMA chunk, for each destination processor IF(IPROC /= IPROCLAST) THEN ! we got onto a new process, we still need to finish the last block of the previous ! process IF(IROF > 1) THEN KGPTRSEND(1,IBLOCK,IPROCLAST)=IBFIRST KGPTRSEND(2,IBLOCK,IPROCLAST)=IROF-1 ENDIF IF(IROF <= NPROMA) IBFIRST=IROF IPROCLAST=IPROC ENDIF ! my offset of the first gridpoint in this row (globally, in EW-direction) IFIRST=D%NSTA(D%NPTRFLOFF+JGL,MY_REGION_EW) ! my offset of the last gridpoint in this row (globally, in EW-direction) ILAST =IFIRST + D%NONL(D%NPTRFLOFF+JGL,MY_REGION_EW) -1 ! now go through all gridpoints on this latitude DO JBL=IFIRST,ILAST IF(IROF == NPROMA) THEN ! this block is full! IBLAST=IROF KGPTRSEND(1,IBLOCK,IPROC)=IBFIRST KGPTRSEND(2,IBLOCK,IPROC)=IBLAST IF(IBLOCK < NGPBLKS) IBLOCK=IBLOCK+1 IROF=0 IBFIRST=1 ENDIF IROF=IROF+1 ENDDO ENDDO IF(IROF /= 1.AND.IROF /= IBFIRST) THEN ! non-empty residual block after last latitude line IBLAST=IROF-1 KGPTRSEND(1,IBLOCK,IPROC)=IBFIRST KGPTRSEND(2,IBLOCK,IPROC)=IBLAST ENDIF ! sum up over blocks KGPTRRECV(:)=SUM(KGPTRSEND(2,:,:),1)-SUM(KGPTRSEND(1,:,:),1)+NGPBLKS END SUBROUTINE INIGPTR END MODULE INIGPTR_MOD