! (C) Copyright 2008- ECMWF. ! (C) Copyright 2008- 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. ! SUBROUTINE GPNORM_TRANS(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,KRESOL,LPGP_ON_GPU) !**** *GPNORM_TRANS* - calculate grid-point norms ! Purpose. ! -------- ! calculate grid-point norms using a 2 stage (NPRTRV,NPRTRW) communication rather ! than an approach using a more expensive global gather collective communication !** Interface. ! ---------- ! CALL GPNORM_TRANS(...) ! Explicit arguments : ! -------------------- ! PGP(:,:,:) - gridpoint fields (input) ! PGP is dimensioned (NPROMA,KFIELDS,NGPBLKS) where ! NPROMA is the blocking factor, KFIELDS the total number ! of fields and NGPBLKS the number of NPROMA blocks. ! KFIELDS - number of fields (input) ! (these do not have to be just levels) ! KPROMA - required blocking factor (input) ! PAVE - average (output) ! PMIN - minimum (input/output) ! PMAX - maximum (input/output) ! LDAVE_ONLY - T : PMIN and PMAX already contain local MIN and MAX ! KRESOL - resolution tag (optional) ! default assumes first defined resolution ! LPGP_ON_GPU - T : PGP is already present on GPU ! so host/device updates in TRGTOL are skipped ! ! Author. ! ------- ! George Mozdzynski *ECMWF* ! Modifications. ! -------------- ! Original : 19th Sept 2008 ! R. El Khatib 07-08-2009 Optimisation directive for NEC ! ------------------------------------------------------------------ USE PARKIND1, ONLY: JPIM, JPRB, JPRD USE PARKIND_ECTRANS, ONLY: JPRBT !ifndef INTERFACE USE TPM_GEN, ONLY: NOUT USE TPM_DIM, ONLY: R USE TPM_TRANS, ONLY: LGPNORM, NGPBLKS, NPROMA USE TPM_DISTR, ONLY: D, NPRCIDS, NPRTRV, NPRTRW, MYSETV, MYSETW USE TPM_GEOMETRY, ONLY: G USE TPM_FIELDS, ONLY: F USE SET_RESOL_MOD, ONLY: SET_RESOL USE SET2PE_MOD, ONLY: SET2PE USE MPL_MODULE, ONLY: MPL_RECV, MPL_SEND, JP_BLOCKING_STANDARD #ifdef USE_RAW_MPI USE MPI_F08, ONLY: MPI_COMM, MPI_STATUS, MPI_REAL8, MPI_SEND, MPI_RECV, MPI_GET_COUNT USE MPL_DATA_MODULE, ONLY: MPL_COMM_OML USE OML_MOD, ONLY: OML_MY_THREAD USE TPM_GEN, ONLY: LMPOFF #endif USE ABORT_TRANS_MOD, ONLY: ABORT_TRANS USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK USE TRGTOL_MOD, ONLY: TRGTOL_HANDLE, PREPARE_TRGTOL, TRGTOL USE TPM_TRANS, ONLY: GROWING_ALLOCATION USE BUFFERED_ALLOCATOR_MOD, ONLY: BUFFERED_ALLOCATOR, MAKE_BUFFERED_ALLOCATOR, INSTANTIATE_ALLOCATOR !endif INTERFACE IMPLICIT NONE ! Declaration of arguments REAL(KIND=JPRB) ,INTENT(IN) :: PGP(:,:,:) INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA REAL(KIND=JPRB) ,INTENT(OUT) :: PAVE(:) REAL(KIND=JPRB) ,INTENT(INOUT) :: PMIN(:) REAL(KIND=JPRB) ,INTENT(INOUT) :: PMAX(:) LOGICAL ,INTENT(IN) :: LDAVE_ONLY INTEGER(KIND=JPIM),OPTIONAL, INTENT(IN) :: KRESOL LOGICAL ,OPTIONAL, INTENT(IN) :: LPGP_ON_GPU !ifndef INTERFACE ! Local variables REAL(KIND=JPHOOK) :: ZHOOK_HANDLE INTEGER(KIND=JPIM) :: IUBOUND(4) INTEGER(KIND=JPIM) :: IVSET(KFIELDS) INTEGER(KIND=JPIM),ALLOCATABLE :: IVSETS(:) INTEGER(KIND=JPIM),ALLOCATABLE :: IVSETG(:,:) !GPU REAL(KIND=JPRBT) :: V REAL(KIND=JPRD) :: ZPAVE_SUM REAL(KIND=JPRBT), POINTER :: PREEL_REAL(:) REAL(KIND=JPRD),ALLOCATABLE :: ZAVE(:,:) REAL(KIND=JPRBT),ALLOCATABLE :: ZMINGL(:,:) REAL(KIND=JPRBT),ALLOCATABLE :: ZMAXGL(:,:) REAL(KIND=JPRBT),ALLOCATABLE :: ZMINGPN(:) REAL(KIND=JPRBT),ALLOCATABLE :: ZMAXGPN(:) REAL(KIND=JPRD),ALLOCATABLE :: ZAVEG(:,:) REAL(KIND=JPRB),ALLOCATABLE :: ZMING(:) REAL(KIND=JPRB),ALLOCATABLE :: ZMAXG(:) REAL(KIND=JPRD),ALLOCATABLE :: ZSND(:) REAL(KIND=JPRD),ALLOCATABLE :: ZRCV(:) INTEGER(KIND=JPIM) :: J,JGL,IGL,JL,JF,IF_GP,IF_SCALARS_G,IF_FS,JSETV,JSETW INTEGER(KIND=JPIM) :: IPROC,ITAG,ILEN,ILENR,IBEG,IEND TYPE(BUFFERED_ALLOCATOR) :: ALLOCATOR TYPE(TRGTOL_HANDLE) :: HTRGTOL LOGICAL :: LLPGP_ON_GPU #ifdef USE_RAW_MPI ! Buffers ZSND/ZRCV are REAL(KIND=JPRD) (always double), so the MPI datatype is always MPI_REAL8 TYPE(MPI_COMM) :: LOCAL_COMM TYPE(MPI_STATUS) :: ISTATUS INTEGER(KIND=JPIM) :: IERROR #endif ! ------------------------------------------------------------------ IF (LHOOK) CALL DR_HOOK('GPNORM_TRANS',0,ZHOOK_HANDLE) #ifdef USE_RAW_MPI IF (.NOT. LMPOFF) THEN LOCAL_COMM%MPI_VAL = MPL_COMM_OML( OML_MY_THREAD() ) ENDIF #endif ! Set current resolution CALL SET_RESOL(KRESOL) ! Set defaults NPROMA = KPROMA NGPBLKS = (D%NGPTOT-1)/NPROMA+1 ! Consistency checks LLPGP_ON_GPU = .FALSE. IF (PRESENT(LPGP_ON_GPU)) LLPGP_ON_GPU = LPGP_ON_GPU IF (.NOT. LLPGP_ON_GPU) THEN IUBOUND(1:3)=UBOUND(PGP) IF(IUBOUND(1) < NPROMA) THEN WRITE(NOUT,*)'GPNORM_TRANS:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA CALL ABORT_TRANS('GPNORM_TRANS:FIRST DIMENSION OF PGP TOO SMALL ') ENDIF IF(IUBOUND(2) < KFIELDS) THEN WRITE(NOUT,*)'GPNORM_TRANS:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),KFIELDS CALL ABORT_TRANS('GPNORM_TRANS:SECOND DIMENSION OF PGP TOO SMALL ') ENDIF IF(IUBOUND(3) < NGPBLKS) THEN WRITE(NOUT,*)'GPNORM_TRANS:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS CALL ABORT_TRANS('GPNORM_TRANS:THIRD DIMENSION OF PGP TOO SMALL ') ENDIF ENDIF ASSOCIATE(F_RW=>F%RW, D_NSTAGTF=>D%NSTAGTF, D_NPTRLS=>D%NPTRLS, G_NLOEN=>G%NLOEN) IF_GP=KFIELDS IF_SCALARS_G=KFIELDS ! Compute V-set distribution and number of fields belonging to me IF_FS=0 DO J=1,KFIELDS IVSET(J)=MOD(J-1,NPRTRV)+1 IF(IVSET(J)==MYSETV)THEN IF_FS=IF_FS+1 ENDIF ENDDO ALLOCATE(ZAVE(IF_FS,R%NDGL)) ALLOCATE(ZMINGL(IF_FS,R%NDGL)) ALLOCATE(ZMAXGL(IF_FS,R%NDGL)) ALLOCATE(ZMINGPN(IF_FS)) ALLOCATE(ZMAXGPN(IF_FS)) ! Compute number of fields belonging to each V set (IVSETS) and local-to-global indexing array ! (IVSETG) ALLOCATE(IVSETS(NPRTRV)) IVSETS(:)=0 DO J=1,KFIELDS IVSETS(IVSET(J))=IVSETS(IVSET(J))+1 ENDDO ALLOCATE(IVSETG(NPRTRV,MAXVAL(IVSETS(:)))) IVSETG(:,:)=0 IVSETS(:)=0 DO J=1,KFIELDS IVSETS(IVSET(J))=IVSETS(IVSET(J))+1 IVSETG(IVSET(J),IVSETS(IVSET(J)))=J ENDDO ! IT IS IMPORTANT THAT SUMS ARE NOW DONE IN LATITUDE ORDER ALLOCATE(ZAVEG(R%NDGL,KFIELDS)) ALLOCATE(ZMING(KFIELDS)) ALLOCATE(ZMAXG(KFIELDS)) ! Rearrange grid point data so full latitude lines are present on one task ALLOCATOR = MAKE_BUFFERED_ALLOCATOR() HTRGTOL = PREPARE_TRGTOL(ALLOCATOR,IF_GP,IF_FS) CALL INSTANTIATE_ALLOCATOR(ALLOCATOR, GROWING_ALLOCATION) LGPNORM=.TRUE. CALL TRGTOL(ALLOCATOR,HTRGTOL,PREEL_REAL,IF_FS,IF_GP,0,IF_SCALARS_G,& & KVSETSC=IVSET,PGP=PGP,LPGP_ON_GPU=LLPGP_ON_GPU) LGPNORM=.FALSE. IBEG=1 IEND=D%NDGL_FS #ifdef OMPGPU !$OMP TARGET DATA MAP(ALLOC:ZAVE,ZMINGL,ZMAXGL,ZMINGPN,ZMAXGPN,ZAVEG,ZMING,ZMAXG) & !$OMP& MAP(TO:IVSETS,IVSETG) MAP(ALLOC:F_RW,D_NSTAGTF,D_NPTRLS,G_NLOEN) #endif #ifdef ACCGPU !$ACC DATA CREATE(ZAVE,ZMINGL,ZMAXGL,ZMINGPN,ZMAXGPN,ZAVEG,ZMING,ZMAXG) & !$ACC& COPYIN(IVSETS,IVSETG) PRESENT(F_RW,D_NSTAGTF,D_NPTRLS,G_NLOEN) #endif CALL GSTATS(1429,0) IF (IF_FS > 0) THEN ! PREEL_REAL is only meaningfully device-mapped when IF_FS > 0 #ifdef OMPGPU !$OMP TARGET DATA MAP(ALLOC:PREEL_REAL) IF (IF_FS > 0) #endif #ifdef ACCGPU !$ACC DATA PRESENT(PREEL_REAL) IF (IF_FS > 0) #endif #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC KERNELS #endif DO JF=1,IF_FS ZMINGL(JF,IBEG:IEND)=HUGE(1_JPRBT) ZMAXGL(JF,IBEG:IEND)=-HUGE(1_JPRBT) ENDDO #ifdef ACCGPU !$ACC END KERNELS #endif ! First compute average, minimum, and maximum for each field and latitude line #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL,V) #endif #ifdef ACCGPU !$ACC KERNELS #endif DO JGL=IBEG,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 DO JF=1,IF_FS ZAVE(JF,JGL)=0.0_JPRB #ifdef ACCGPU !$ACC loop #endif DO JL=1,G_NLOEN(IGL) V = PREEL_REAL(IF_FS*D_NSTAGTF(JGL)+(JF-1)*(D_NSTAGTF(JGL+1)-D_NSTAGTF(JGL))+JL) ZAVE(JF,JGL)=ZAVE(JF,JGL)+V ZMINGL(JF,JGL)=MIN(ZMINGL(JF,JGL),V) ZMAXGL(JF,JGL)=MAX(ZMAXGL(JF,JGL),V) ENDDO ENDDO ENDDO #ifdef ACCGPU !$ACC END KERNELS #endif ! Then compute minimum and maximum for each field across all latitude lines #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC KERNELS #endif DO JF=1,IF_FS ZMINGPN(JF)=MINVAL(ZMINGL(JF,IBEG:IEND)) ZMAXGPN(JF)=MAXVAL(ZMAXGL(JF,IBEG:IEND)) ENDDO #ifdef ACCGPU !$ACC END KERNELS #endif ! Compute the average for each field and latitude line, weighted by Gaussian weights #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC KERNELS #endif DO JGL=IBEG,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 DO JF=1,IF_FS ZAVE(JF,JGL)=ZAVE(JF,JGL)*F_RW(IGL)/G_NLOEN(IGL) ENDDO ENDDO #ifdef ACCGPU !$ACC END KERNELS #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif ENDIF ! IF_FS > 0 CALL GSTATS(1429,1) ! Initialise global aggregate arrays #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP COLLAPSE(2) #endif DO JF=1,KFIELDS DO JGL=1,R%NDGL ZAVEG(JGL,JF)=0.0_JPRD ENDDO ENDDO #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC PARALLEL LOOP #endif DO JF=1,KFIELDS ZMING(JF)=0.0_JPRB ZMAXG(JF)=0.0_JPRB ENDDO ! Put my average data in ZAVEG #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,IF_FS DO JGL=IBEG,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZAVEG(IGL,IVSETG(MYSETV,JF))=ZAVE(JF,JGL) ENDDO ENDDO ! If local mins / maxs are provided by user, just load them into the work arrays IF (LDAVE_ONLY) THEN #ifdef OMPGPU !$OMP TARGET DATA MAP(TO:PMIN,PMAX) #endif #ifdef ACCGPU !$ACC DATA COPYIN(PMIN,PMAX) #endif #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC KERNELS #endif DO JF=1,KFIELDS ZMING(JF)=PMIN(JF) ZMAXG(JF)=PMAX(JF) ENDDO #ifdef ACCGPU !$ACC END KERNELS #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif ! Else take my locally computed values and fill the corresponding sections of ZMING / ZMAXG ELSE ! LDAVE_ONLY #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC KERNELS #endif DO JF=1,IF_FS ZMING(IVSETG(MYSETV,JF))=REAL(ZMINGPN(JF),JPRB) ZMAXG(IVSETG(MYSETV,JF))=REAL(ZMAXGPN(JF),JPRB) ENDDO #ifdef ACCGPU !$ACC END KERNELS #endif ENDIF ! LDAVE_ONLY ! RECEIVE ABOVE FROM OTHER NPRTRV SETS FOR SAME LATS BUT DIFFERENT FIELDS ITAG=123 CALL GSTATS(815,0) IF (MYSETV==1) THEN DO JSETV=2,NPRTRV ! Determine size of data to receive from this V set IF (LDAVE_ONLY) THEN ILEN=IEND*IVSETS(JSETV)+2*KFIELDS ELSE ILEN=(IEND+2)*IVSETS(JSETV) ENDIF IF (ILEN > 0) THEN ALLOCATE(ZRCV(ILEN)) CALL SET2PE(IPROC,0,0,MYSETW,JSETV) #ifdef OMPGPU !$OMP TARGET DATA MAP(ALLOC:ZRCV) #endif #ifdef ACCGPU !$ACC DATA CREATE(ZRCV) #endif #ifdef USE_GPU_AWARE_MPI #ifdef OMPGPU !$OMP TARGET DATA USE_DEVICE_ADDR(ZRCV) #endif #ifdef ACCGPU !$ACC HOST_DATA USE_DEVICE(ZRCV) #endif #endif #ifdef USE_RAW_MPI CALL MPI_RECV(ZRCV(:), ILEN, MPI_REAL8, NPRCIDS(IPROC) - 1, ITAG, LOCAL_COMM, ISTATUS, IERROR) CALL MPI_GET_COUNT(ISTATUS, MPI_REAL8, ILENR, IERROR) #else CALL MPL_RECV(ZRCV(:), KSOURCE=NPRCIDS(IPROC), KTAG=ITAG, KMP_TYPE=JP_BLOCKING_STANDARD, & & KOUNT=ILENR, CDSTRING='GPNORM_TRANS:V') #endif #ifdef USE_GPU_AWARE_MPI #ifdef ACCGPU !$ACC END HOST_DATA #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #else #ifdef OMPGPU !$OMP TARGET UPDATE TO(ZRCV) #endif #ifdef ACCGPU !$ACC UPDATE DEVICE(ZRCV) #endif #endif IF (ILENR /= ILEN) THEN CALL ABOR1('GPNORM_TRANS:ILENR /= ILEN') ENDIF IF (.NOT. LDAVE_ONLY) THEN #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,IVSETS(JSETV) DO JGL=1,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZAVEG(IGL,IVSETG(JSETV,JF))=ZRCV((JF-1)*(IEND+2)+JGL) ENDDO ZMING(IVSETG(JSETV,JF))=REAL(ZRCV((JF-1)*(IEND+2)+IEND+1),JPRB) ZMAXG(IVSETG(JSETV,JF))=REAL(ZRCV((JF-1)*(IEND+2)+IEND+2),JPRB) ENDDO ELSE ! .NOT. LDAVE_ONLY #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,IVSETS(JSETV) DO JGL=1,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZAVEG(IGL,IVSETG(JSETV,JF))=ZRCV((JF-1)*IEND+JGL) ENDDO ENDDO #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC PARALLEL LOOP #endif DO JF=1,KFIELDS ZMING(JF)=MIN(ZMING(JF),REAL(ZRCV(IEND*IVSETS(JSETV)+2*(JF-1)+1),JPRB)) ZMAXG(JF)=MAX(ZMAXG(JF),REAL(ZRCV(IEND*IVSETS(JSETV)+2*(JF-1)+2),JPRB)) ENDDO ENDIF #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif DEALLOCATE(ZRCV) ENDIF ! ILEN > 0 ENDDO ! JSETV=2,NPRTRV ELSE ! MYSETV==1 ! Determine size of data to send to first V set IF (LDAVE_ONLY) THEN ILEN=IEND*IVSETS(MYSETV)+2*KFIELDS ELSE ILEN=(IEND+2)*IVSETS(MYSETV) ENDIF IF (ILEN > 0) THEN CALL SET2PE(IPROC,0,0,MYSETW,1) ALLOCATE(ZSND(ILEN)) #ifdef OMPGPU !$OMP TARGET DATA MAP(ALLOC:ZSND) #endif #ifdef ACCGPU !$ACC DATA CREATE(ZSND) #endif IF (.NOT. LDAVE_ONLY) THEN #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,IF_FS DO JGL=1,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZSND((JF-1)*(IEND+2)+JGL)=ZAVEG(IGL,IVSETG(MYSETV,JF)) ENDDO ZSND((JF-1)*(IEND+2)+IEND+1)=ZMING(IVSETG(MYSETV,JF)) ZSND((JF-1)*(IEND+2)+IEND+2)=ZMAXG(IVSETG(MYSETV,JF)) ENDDO ELSE ! .NOT. LDAVE_ONLY #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,IF_FS DO JGL=1,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZSND((JF-1)*IEND+JGL)=ZAVEG(IGL,IVSETG(MYSETV,JF)) ENDDO ENDDO #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC PARALLEL LOOP #endif DO JF=1,KFIELDS ZSND(IEND*IF_FS+2*(JF-1)+1)=ZMING(JF) ZSND(IEND*IF_FS+2*(JF-1)+2)=ZMAXG(JF) ENDDO ENDIF #ifdef USE_GPU_AWARE_MPI #ifdef OMPGPU !$OMP TARGET DATA USE_DEVICE_ADDR(ZSND) #endif #ifdef ACCGPU !$ACC HOST_DATA USE_DEVICE(ZSND) #endif #else #ifdef OMPGPU !$OMP TARGET UPDATE FROM(ZSND) #endif #ifdef ACCGPU !$ACC UPDATE HOST(ZSND) #endif #endif #ifdef USE_RAW_MPI CALL MPI_SEND(ZSND(:), ILEN, MPI_REAL8, NPRCIDS(IPROC) - 1, ITAG, LOCAL_COMM, IERROR) #else CALL MPL_SEND(ZSND(:), KDEST=NPRCIDS(IPROC), KTAG=ITAG, KMP_TYPE=JP_BLOCKING_STANDARD, & & CDSTRING='GPNORM_TRANS:V') #endif #ifdef USE_GPU_AWARE_MPI #ifdef ACCGPU !$ACC END HOST_DATA #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif DEALLOCATE(ZSND) ENDIF ENDIF ! FINALLY RECEIVE CONTRIBUTIONS FROM OTHER NPRTRW SETS IF (MYSETV == 1) THEN IF (MYSETW == 1) THEN DO JSETW=2,NPRTRW IBEG=1 IEND=D%NULTPP(JSETW) ! Determine size of data to receive from this W set IF (LDAVE_ONLY) THEN ILEN=IEND*KFIELDS+2*KFIELDS ELSE ILEN=(IEND+2)*KFIELDS ENDIF IF (ILEN > 0) THEN ALLOCATE(ZRCV(ILEN)) CALL SET2PE(IPROC,0,0,JSETW,1) #ifdef OMPGPU !$OMP TARGET DATA MAP(ALLOC:ZRCV) #endif #ifdef ACCGPU !$ACC DATA CREATE(ZRCV) #endif #ifdef USE_GPU_AWARE_MPI #ifdef OMPGPU !$OMP TARGET DATA USE_DEVICE_ADDR(ZRCV) #endif #ifdef ACCGPU !$ACC HOST_DATA USE_DEVICE(ZRCV) #endif #endif #ifdef USE_RAW_MPI CALL MPI_RECV(ZRCV(:), ILEN, MPI_REAL8, NPRCIDS(IPROC) - 1, ITAG, LOCAL_COMM, ISTATUS, & & IERROR) CALL MPI_GET_COUNT(ISTATUS, MPI_REAL8, ILENR, IERROR) #else CALL MPL_RECV(ZRCV(:), KSOURCE=NPRCIDS(IPROC), KTAG=ITAG, KMP_TYPE=JP_BLOCKING_STANDARD, & & KOUNT=ILENR, CDSTRING='GPNORM_TRANS:W') #endif #ifdef USE_GPU_AWARE_MPI #ifdef ACCGPU !$ACC END HOST_DATA #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #else #ifdef OMPGPU !$OMP TARGET UPDATE TO(ZRCV) #endif #ifdef ACCGPU !$ACC UPDATE DEVICE(ZRCV) #endif #endif IF (ILENR /= ILEN) THEN CALL ABOR1('GPNORM_TRANS:ILENR /= ILEN') ENDIF IF (.NOT. LDAVE_ONLY) THEN #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,KFIELDS DO JGL=1,IEND IGL = D_NPTRLS(JSETW) + JGL - 1 ZAVEG(IGL,JF)=ZRCV((JF-1)*(IEND+2)+JGL) ENDDO ZMING(JF)=MIN(ZMING(JF),REAL(ZRCV((JF-1)*(IEND+2)+IEND+1),JPRB)) ZMAXG(JF)=MAX(ZMAXG(JF),REAL(ZRCV((JF-1)*(IEND+2)+IEND+2),JPRB)) ENDDO ELSE #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,KFIELDS DO JGL=1,IEND IGL = D_NPTRLS(JSETW) + JGL - 1 ZAVEG(IGL,JF)=ZRCV((JF-1)*IEND+JGL) ENDDO ENDDO #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC PARALLEL LOOP #endif DO JF=1,KFIELDS ZMING(JF)=MIN(ZMING(JF),REAL(ZRCV(IEND*KFIELDS+2*(JF-1)+1),JPRB)) ZMAXG(JF)=MAX(ZMAXG(JF),REAL(ZRCV(IEND*KFIELDS+2*(JF-1)+2),JPRB)) ENDDO ENDIF #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif DEALLOCATE(ZRCV) ENDIF ENDDO ELSE ! MYSETW == 1 ! Determine size of data to send to first W set IF (LDAVE_ONLY) THEN ILEN=IEND*KFIELDS+2*KFIELDS ELSE ILEN=(IEND+2)*KFIELDS ENDIF IF (ILEN > 0) THEN CALL SET2PE(IPROC,0,0,1,1) ALLOCATE(ZSND(ILEN)) #ifdef OMPGPU !$OMP TARGET DATA MAP(ALLOC:ZSND) #endif #ifdef ACCGPU !$ACC DATA CREATE(ZSND) #endif IF (.NOT. LDAVE_ONLY) THEN #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,KFIELDS DO JGL=1,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZSND((JF-1)*(IEND+2)+JGL)=ZAVEG(IGL,JF) ENDDO ZSND((JF-1)*(IEND+2)+IEND+1)=ZMING(JF) ZSND((JF-1)*(IEND+2)+IEND+2)=ZMAXG(JF) ENDDO ELSE #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IGL) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(IGL) #endif DO JF=1,KFIELDS DO JGL=1,IEND IGL = D_NPTRLS(MYSETW) + JGL - 1 ZSND((JF-1)*IEND+JGL)=ZAVEG(IGL,JF) ENDDO ENDDO #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO #endif #ifdef ACCGPU !$ACC PARALLEL LOOP #endif DO JF=1,KFIELDS ZSND(IEND*KFIELDS+2*(JF-1)+1)=ZMING(JF) ZSND(IEND*KFIELDS+2*(JF-1)+2)=ZMAXG(JF) ENDDO ENDIF #ifdef USE_GPU_AWARE_MPI #ifdef OMPGPU !$OMP TARGET DATA USE_DEVICE_ADDR(ZSND) #endif #ifdef ACCGPU !$ACC HOST_DATA USE_DEVICE(ZSND) #endif #else #ifdef OMPGPU !$OMP TARGET UPDATE FROM(ZSND) #endif #ifdef ACCGPU !$ACC UPDATE HOST(ZSND) #endif #endif #ifdef USE_RAW_MPI CALL MPI_SEND(ZSND(:), ILEN, MPI_REAL8, NPRCIDS(IPROC) - 1, ITAG, LOCAL_COMM, IERROR) #else CALL MPL_SEND(ZSND(:), KDEST=NPRCIDS(IPROC), KTAG=ITAG, KMP_TYPE=JP_BLOCKING_STANDARD, & & CDSTRING='GPNORM_TRANS:V') #endif #ifdef USE_GPU_AWARE_MPI #ifdef ACCGPU !$ACC END HOST_DATA #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #endif #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif DEALLOCATE(ZSND) ENDIF ENDIF ENDIF CALL GSTATS(815,1) ! Finally, load final values into output arrays, copying back to host at the end IF (MYSETW == 1 .AND. MYSETV == 1) THEN #ifdef OMPGPU !$OMP TARGET DATA MAP(TOFROM:PAVE,PMIN,PMAX) #endif #ifdef ACCGPU !$ACC DATA COPY(PAVE,PMIN,PMAX) #endif #ifdef OMPGPU !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ZPAVE_SUM) #endif #ifdef ACCGPU !$ACC PARALLEL LOOP PRIVATE(ZPAVE_SUM) #endif DO JF=1,KFIELDS ZPAVE_SUM=0.0_JPRD DO JGL=1,R%NDGL ZPAVE_SUM=ZPAVE_SUM+ZAVEG(JGL,JF) ENDDO PAVE(JF)=REAL(ZPAVE_SUM,JPRB) PMIN(JF)=ZMING(JF) PMAX(JF)=ZMAXG(JF) ENDDO #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif ENDIF #ifdef OMPGPU !$OMP END TARGET DATA #endif #ifdef ACCGPU !$ACC END DATA #endif END ASSOCIATE DEALLOCATE(ZAVEG) DEALLOCATE(ZMING) DEALLOCATE(ZMAXG) DEALLOCATE(IVSETS) DEALLOCATE(IVSETG) DEALLOCATE(ZMAXGPN) DEALLOCATE(ZMINGPN) DEALLOCATE(ZMAXGL) DEALLOCATE(ZMINGL) DEALLOCATE(ZAVE) IF (LHOOK) CALL DR_HOOK('GPNORM_TRANS',1,ZHOOK_HANDLE) ! ------------------------------------------------------------------ !endif INTERFACE END SUBROUTINE GPNORM_TRANS