diff --git a/src/trans/common/internal/tpm_gen.F90 b/src/trans/common/internal/tpm_gen.F90 index f153f4b5d..cf4657d18 100644 --- a/src/trans/common/internal/tpm_gen.F90 +++ b/src/trans/common/internal/tpm_gen.F90 @@ -42,7 +42,7 @@ MODULE TPM_GEN ! NSTACK_MEMORY_TR : optional memory strategy in gridpoint transpositions ! = 0 : prefer heap (slower but less memory consuming) ! > 0 : prefer stack (faster but more memory consuming) -INTEGER(KIND=JPIM) :: NSTACK_MEMORY_TR +INTEGER(KIND=JPIM) :: NSTACK_MEMORY_TR = 0 LOGICAL, ALLOCATABLE :: LENABLED(:) ! true: the resolution is enabled (it has been ! initialised and has not been released afterward) diff --git a/src/trans/gpu/external/gath_spec.F90 b/src/trans/gpu/external/gath_spec.F90 index 2e7746780..1f515be73 100755 --- a/src/trans/gpu/external/gath_spec.F90 +++ b/src/trans/gpu/external/gath_spec.F90 @@ -82,9 +82,13 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD INTEGER(KIND=JPIM) :: IVSET(KFGATHG) INTEGER(KIND=JPIM) :: IFRECV,IFSEND,J INTEGER(KIND=JPIM) :: IFLD,ICOEFF -INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G +INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G, ISPEC2MX INTEGER(KIND=JPIM) :: IPOSSP(NPRTRW+1) +INTEGER(KIND=JPIM) :: IUMPP(NPRTRW) +INTEGER(KIND=JPIM) :: IPTRMS(NPRTRW) INTEGER(KIND=JPIM),ALLOCATABLE :: IDIM0G(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IALLMS(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IKN(:) LOGICAL :: LLDIM1_IS_FLD REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -111,8 +115,11 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ISMAX = R%NSMAX IF(PRESENT(KSMAX)) ISMAX = KSMAX ALLOCATE(IDIM0G(0:ISMAX)) +ALLOCATE(IALLMS(ISMAX+1)) +ALLOCATE(IKN(0:ISMAX)) IF(ISMAX /= R%NSMAX) THEN CALL SUWAVEDI(ISMAX,ISMAX,NPRTRW,MYSETW,KPOSSP=IPOSSP,KSPEC2=ISPEC2,& + & KUMPP=IUMPP,KALLMS=IALLMS,KPTRMS=IPTRMS,KSPEC2MX=ISPEC2MX, & & KDIM0G=IDIM0G) ISPEC2_G = (ISMAX+1)*(ISMAX+2) ELSE @@ -120,7 +127,14 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ISPEC2_G = R%NSPEC2_G IPOSSP(:) = D%NPOSSP(:) IDIM0G(:) = D%NDIM0G(:) + ISPEC2MX = D%NSPEC2MX + IUMPP(:) = D%NUMPP(:) + IALLMS(:) = D%NALLMS(:) + IPTRMS(:) = D%NPTRMS(:) ENDIF +DO J=0,ISMAX + IKN(J)=2*(ISMAX+1-J) +ENDDO IFSEND = 0 IFRECV = 0 @@ -181,7 +195,7 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ENDIF CALL GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,IVSET,PSPEC,LLDIM1_IS_FLD,& - & ISMAX,ISPEC2,ISPEC2_G,IPOSSP,IDIM0G,LDZA0IP) + & ISMAX,ISPEC2,ISPEC2MX,ISPEC2_G,IPOSSP,IDIM0G,IUMPP,IALLMS,IPTRMS,IKN,LDZA0IP) DEALLOCATE(IDIM0G) IF (LHOOK) CALL DR_HOOK('GATH_SPEC',1,ZHOOK_HANDLE) @@ -190,4 +204,3 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ! ------------------------------------------------------------------ END SUBROUTINE GATH_SPEC - diff --git a/src/trans/gpu/internal/gath_spec_control_mod.F90 b/src/trans/gpu/internal/gath_spec_control_mod.F90 index da94be477..b41944fa4 100755 --- a/src/trans/gpu/internal/gath_spec_control_mod.F90 +++ b/src/trans/gpu/internal/gath_spec_control_mod.F90 @@ -11,7 +11,7 @@ MODULE GATH_SPEC_CONTROL_MOD CONTAINS SUBROUTINE GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& - & KSMAX,KSPEC2,KSPEC2_G,KPOSSP,KDIM0G,LDZA0IP) + & KSMAX,KSPEC2,KSPEC2MX,KSPEC2G,KPOSSP,KDIM0G,KUMPP,KALLMS,KPTRMS,KN,LDZA0IP) !**** *GATH_SPEC_CONTROL* - Gather global spectral array from processors @@ -26,22 +26,44 @@ SUBROUTINE GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& ! Explicit arguments : ! -------------------- ! PSPECG(:,:) - Global spectral array -! KFGATHG - Global number of fields to be distributed +! KFGATHG - Global number of fields to be gathered ! KTO(:) - Processor responsible for distributing each field ! KVSET(:) - "B-Set" for each field ! PSPEC(:,:) - Local spectral array -! LDZA0IP - Set first coefficients (imaginary part) to zero +! LDIM1_IS_FLD - .TRUE. if first dimension contains the fields +! KSMAX - Spectral truncation limit +! KSPEC2 - Local number of spectral coefficients +! KSPEC2MX - Maximum local number of spectral coefficients +! KSPEC2G - Global number of spectral coefficients +! KPOSSP - Position of local waves for each task +! KDIM0G - Defines partitioning of global spectral fields among PEs +! KUMPP - Number of spectral waves on this a-set +! KALLMS - Wave numbers for all a-set concatenated together to give all wave numbers in a-set order +! KPTRMS - Pointer to the first wave number of a given a-set in kallms array. +! KN - Number of spectral coefficients for each m wave +! LDZA0IP - Set first coefficients (imaginary part) to zero (global model only) +! Externals. SET2PE - compute "A and B" set from PE +! ---------- MPL.. - message passing routines + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 2000-04-01 +! R. El Khatib 02-Dec-2020 re-write for optimizations and merge with LAM counterpart ! ------------------------------------------------------------------ USE PARKIND1, ONLY: JPIM, JPRB USE MPL_MODULE, ONLY: MPL_RECV, MPL_SEND, MPL_BARRIER, MPL_WAIT, JP_BLOCKING_STANDARD, & & JP_NON_BLOCKING_STANDARD -USE TPM_DISTR, ONLY: MTAGDISTSP, NPRCIDS, NPRTRW, MYSETV, MYSETW, MYPROC, NPROC +USE TPM_DISTR, ONLY: MTAGDISTSP, NPRCIDS, NPRTRW, MYSETV, MYSETW, MYPROC, NPROC, NPRTRV USE ABORT_TRANS_MOD, ONLY: ABORT_TRANS USE SET2PE_MOD, ONLY: SET2PE -! +USE TPM_GEOMETRY, ONLY : G IMPLICIT NONE @@ -53,175 +75,234 @@ SUBROUTINE GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& LOGICAL ,OPTIONAL, INTENT(IN) :: LDIM1_IS_FLD INTEGER(KIND=JPIM) , INTENT(IN) :: KSMAX INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2 -INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2_G +INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2MX +INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2G INTEGER(KIND=JPIM) , INTENT(IN) :: KPOSSP(:) INTEGER(KIND=JPIM) , INTENT(IN) :: KDIM0G(0:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KUMPP(NPRTRW) +INTEGER(KIND=JPIM) , INTENT(IN) :: KALLMS(KSMAX+1) +INTEGER(KIND=JPIM) , INTENT(IN) :: KPTRMS(NPRTRW) +INTEGER(KIND=JPIM) , INTENT(IN) :: KN(0:KSMAX) LOGICAL ,OPTIONAL, INTENT(IN) :: LDZA0IP -REAL(KIND=JPRB) :: ZFLD(KSPEC2,KFGATHG),ZDUM(KSPEC2) -REAL(KIND=JPRB),ALLOCATABLE :: ZRECV(:,:) -INTEGER(KIND=JPIM) :: JM,JN,II,IFLDR,IFLDS,JFLD,ITAG,IBSET,ILEN,JA,ISND -INTEGER(KIND=JPIM) :: IRCV,ISP,ILENR,ISTA,ISTP,ISENDREQ(KFGATHG),IPOS0,JNM -INTEGER(KIND=JPIM) :: IDIST(KSPEC2_G),IMYFIELDS +REAL(KIND=JPRB) :: ZBUFSEND(KSPEC2MX,COUNT(KVSET(1:KFGATHG) == MYSETV)) +REAL(KIND=JPRB) :: ZRECV(KSPEC2MX,COUNT(KTO(1:KFGATHG) == MYPROC)) +INTEGER(KIND=JPIM) :: IASM0G(0:KSMAX) +INTEGER(KIND=JPIM) :: JM,JN,II,IFLDR,IFLDS,JFLD,ITAG,IB,ILEN(NPRTRW),JA,JB,ISND,JMLOC +INTEGER(KIND=JPIM) :: IPE(NPRTRV,NPRTRW),ILENR,ISENDREQ(NPROC),IPOSSP,JNM,JROC +INTEGER(KIND=JPIM) :: IFLD,IFLDLOC(COUNT(KTO(1:KFGATHG) == MYPROC)),IOFFPROC +INTEGER(KIND=JPIM) :: ILOCFLD(COUNT(KVSET(1:KFGATHG) == MYSETV)) LOGICAL :: LLZA0IP ! ------------------------------------------------------------------ -LLZA0IP=.TRUE. +! Compute help array for distribution + +DO JA=1,NPRTRW + ILEN(JA) = KPOSSP(JA+1)-KPOSSP(JA) +ENDDO +DO JA=1,NPRTRW + DO JB=1,NPRTRV + CALL SET2PE(IPE(JB,JA),0,0,JA,JB) + ENDDO +ENDDO +IASM0G(0)=1 +DO JM=1,KSMAX + IASM0G(JM)=IASM0G(JM-1)+KN(JM-1) +ENDDO + +LLZA0IP=.NOT.G%LAM ! or it should have been coded in the original code, please :-( IF (PRESENT (LDZA0IP)) LLZA0IP=LDZA0IP !GATHER SPECTRAL ARRAY -IF( NPROC == 1 ) THEN - CALL GSTATS(1644,0) - IF(LDIM1_IS_FLD) THEN -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JM,JFLD) - DO JM=1,KSPEC2_G +!Send +ISND=0 +IOFFPROC=0 +IF (KSPEC2 > 0) THEN + CALL GSTATS(810,0) + DO JROC=1,NPROC + IF (JROC /= MYPROC) THEN + IFLD=0 ! counter of fields in PSPEC + IFLDS=0 ! counter of fields in ZBUFSEND DO JFLD=1,KFGATHG - PSPECG(JFLD,JM) =PSPEC(JFLD,JM) + IF (KVSET(JFLD) == MYSETV) THEN + IFLD=IFLD+1 + IF (JROC==KTO(JFLD)) THEN + IFLDS=IFLDS+1 + IF (LDIM1_IS_FLD) THEN + ZBUFSEND(1:KSPEC2,IOFFPROC+IFLDS)=PSPEC(IFLD,1:KSPEC2) + ELSE + ZBUFSEND(1:KSPEC2,IOFFPROC+IFLDS)=PSPEC(1:KSPEC2,IFLD) + ENDIF + ENDIF + ENDIF + ENDDO + IF (IFLDS > 0) THEN + ITAG=MTAGDISTSP+MYPROC + ISND=ISND+1 + CALL MPL_SEND(ZBUFSEND(:,IOFFPROC+1:IOFFPROC+IFLDS),KDEST=NPRCIDS(JROC),KTAG=ITAG,& + & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(ISND),& + & CDSTRING='GATH_SPEC_CONTROL') + ENDIF + IOFFPROC=IOFFPROC+IFLDS + ENDIF + ENDDO + CALL GSTATS(810,1) + +! Myself : + IFLD=0 + IFLDR=0 + DO JFLD=1,KFGATHG + IF (KTO(JFLD) == MYPROC) THEN + IFLD=IFLD+1 + IF (KVSET(JFLD)==MYSETV) THEN + IFLDR = IFLDR+1 + IFLDLOC(IFLDR)=IFLD + ENDIF + ENDIF + ENDDO + IFLD=0 + IFLDR=0 + DO JFLD=1,KFGATHG + IF (KVSET(JFLD)==MYSETV) THEN + IFLD=IFLD+1 + IF (KTO(JFLD) == MYPROC) THEN + IFLDR = IFLDR+1 + ILOCFLD(IFLDR)=IFLD + ENDIF + ENDIF + ENDDO + IF (IFLDR > 0) THEN + IF (LDIM1_IS_FLD) THEN + CALL GSTATS(1644,0) +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(MYSETW) + JM=KALLMS(KPTRMS(MYSETW)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(MYSETW)+1 + PSPECG(IFLDLOC(JFLD),IASM0G(JM):IASM0G(JM)+KN(JM)-1)=PSPEC(ILOCFLD(JFLD),IPOSSP:IPOSSP+KN(JM)-1) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(IFLDLOC(JFLD),II) = 0.0_JPRB + ENDDO + ENDIF ENDDO - ENDDO !$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JM,JFLD) - DO JFLD=1,KFGATHG - DO JM=1,KSPEC2_G - PSPECG(JM,JFLD) =PSPEC(JM,JFLD) + CALL GSTATS(1644,1) + ELSE + CALL GSTATS(1644,0) +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(MYSETW) + JM=KALLMS(KPTRMS(MYSETW)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(MYSETW)+1 + PSPECG(IASM0G(JM):IASM0G(JM)+KN(JM)-1,IFLDLOC(JFLD))=PSPEC(IPOSSP:IPOSSP+KN(JM)-1,ILOCFLD(JFLD)) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(II,IFLDLOC(JFLD)) = 0.0_JPRB + ENDDO + ENDIF ENDDO - ENDDO !$OMP END PARALLEL DO - ENDIF - CALL GSTATS(1644,1) -ELSE - IMYFIELDS = 0 - DO JFLD=1,KFGATHG - IF(KTO(JFLD) == MYPROC) THEN - IMYFIELDS = IMYFIELDS+1 + CALL GSTATS(1644,1) ENDIF - ENDDO - IF(IMYFIELDS>0) THEN - ALLOCATE(ZRECV(KSPEC2_G,IMYFIELDS)) - II = 0 - CALL GSTATS(1804,0) - DO JM=0,KSMAX - DO JN=JM,KSMAX - IDIST(II+1) = KDIM0G(JM)+(JN-JM)*2 - IDIST(II+2) = KDIM0G(JM)+(JN-JM)*2+1 - II = II+2 - ENDDO - ENDDO - CALL GSTATS(1804,1) ENDIF - CALL GSTATS_BARRIER(788) - - !Send - CALL GSTATS(810,0) - IFLDS = 0 - IF(KSPEC2 > 0 )THEN - DO JFLD=1,KFGATHG - - IBSET = KVSET(JFLD) - IF( IBSET == MYSETV )THEN - - IFLDS = IFLDS+1 - ISND = KTO(JFLD) - ITAG = MTAGDISTSP+JFLD+17 - IF(LDIM1_IS_FLD) THEN - ZFLD(1:KSPEC2,IFLDS)=PSPEC(IFLDS,1:KSPEC2) - CALL MPL_SEND(ZFLD(1:KSPEC2,IFLDS),KDEST=NPRCIDS(ISND),KTAG=ITAG,& - &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JFLD),& - &CDSTRING='GATH_SPEC_CONTROL') - ELSE - CALL MPL_SEND(PSPEC(1:KSPEC2,IFLDS),KDEST=NPRCIDS(ISND),KTAG=ITAG,& - &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JFLD),& - &CDSTRING='GATH_SPEC_CONTROL') - ENDIF - ENDIF - ENDDO - ENDIF +ENDIF - ! Recieve - IFLDR = 0 - DO JFLD=1,KFGATHG - IF(KTO(JFLD) == MYPROC) THEN - IBSET = KVSET(JFLD) - IFLDR = IFLDR+1 - DO JA=1,NPRTRW - ILEN = KPOSSP(JA+1)-KPOSSP(JA) - IF( ILEN > 0 )THEN - CALL SET2PE(IRCV,0,0,JA,IBSET) - ITAG = MTAGDISTSP+JFLD+17 - ISTA = KPOSSP(JA) - ISTP = ISTA+ILEN-1 - CALL MPL_RECV(ZRECV(ISTA:ISTP,IFLDR),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& - &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR, & - &CDSTRING='GATH_SPEC_CONTROL') - IF( ILENR /= ILEN )THEN - WRITE(0,'("GATH_SPEC_CONTROL: JFLD=",I4," JA=",I4," ILEN=",I10," ILENR=",I10)')& - &JFLD,JA,ILEN,ILENR +! Receive +DO JA=1,NPRTRW + IF (ILEN(JA) > 0) THEN + DO JB=1,NPRTRV + IF (IPE(JB,JA) /= MYPROC) THEN + ! Locate received fields in source array : + IFLD=0 + IFLDR=0 + DO JFLD=1,KFGATHG + IF (KTO(JFLD) == MYPROC) THEN + IFLD=IFLD+1 + IF (KVSET(JFLD)==JB) THEN + IFLDR = IFLDR+1 + IFLDLOC(IFLDR)=IFLD + ENDIF + ENDIF + ENDDO + IF (IFLDR > 0) THEN + ITAG=MTAGDISTSP+IPE(JB,JA) + CALL GSTATS(810,0) + CALL MPL_RECV(ZRECV(:,1:IFLDR),KSOURCE=NPRCIDS(IPE(JB,JA)),KTAG=ITAG,& + & KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR, & + & CDSTRING='GATH_SPEC_CONTROL') + IF (ILENR /= KSPEC2MX*IFLDR) THEN CALL ABORT_TRANS('GATH_SPEC_CONTROL:INVALID RECEIVE MESSAGE LENGTH') ENDIF + CALL GSTATS(810,1) + CALL GSTATS(1644,0) + IF (LDIM1_IS_FLD) THEN +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(JA) + JM=KALLMS(KPTRMS(JA)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(JA)+1 + PSPECG(IFLDLOC(JFLD),IASM0G(JM):IASM0G(JM)+KN(JM)-1)=ZRECV(IPOSSP:IPOSSP+KN(JM)-1,JFLD) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(IFLDLOC(JFLD),II) = 0.0_JPRB + ENDDO + ENDIF + ENDDO +!$OMP END PARALLEL DO + ELSE +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(JA) + JM=KALLMS(KPTRMS(JA)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(JA)+1 + PSPECG(IASM0G(JM):IASM0G(JM)+KN(JM)-1,IFLDLOC(JFLD))=ZRECV(IPOSSP:IPOSSP+KN(JM)-1,JFLD) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(II,IFLDLOC(JFLD)) = 0.0_JPRB + ENDDO + ENDIF + ENDDO +!$OMP END PARALLEL DO + ENDIF + CALL GSTATS(1644,1) ENDIF - ENDDO - ENDIF - ENDDO - - ! Check for completion of sends - IF(KSPEC2 > 0 )THEN - DO JFLD=1,KFGATHG - IBSET = KVSET(JFLD) - IF( IBSET == MYSETV )THEN - CALL MPL_WAIT(KREQUEST=ISENDREQ(JFLD), & - & CDSTRING='GATH_GRID_CTL: WAIT') ENDIF ENDDO ENDIF - CALL GSTATS(810,1) - CALL GSTATS_BARRIER2(788) - - CALL GSTATS(1644,0) -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JNM,II,JN,ISP) - DO JFLD=1,IMYFIELDS - IF(LDIM1_IS_FLD) THEN - DO JNM=1,KSPEC2_G - PSPECG(JFLD,JNM) = ZRECV(IDIST(JNM),JFLD) - ENDDO - IF (LLZA0IP) THEN - II = 0 - DO JN=0,KSMAX - ISP = KDIM0G(0)+JN*2+1 - II = II+2 - PSPECG(JFLD,II) = 0.0_JPRB - ENDDO - ENDIF - ELSE - DO JNM=1,KSPEC2_G - PSPECG(JNM,JFLD) = ZRECV(IDIST(JNM),JFLD) - ENDDO - IF (LLZA0IP) THEN - II = 0 - DO JN=0,KSMAX - ISP = KDIM0G(0)+JN*2+1 - II = II+2 - PSPECG(II,JFLD) = 0.0_JPRB - ENDDO - ENDIF - ENDIF - ENDDO -!$OMP END PARALLEL DO - CALL GSTATS(1644,1) - IF(ALLOCATED(ZRECV)) DEALLOCATE(ZRECV) +ENDDO +CALL GSTATS_BARRIER2(788) - !Synchronize processors - CALL GSTATS(785,0) - CALL MPL_BARRIER(CDSTRING='GATH_SPEC_CONTROL:') - CALL GSTATS(785,1) +! Check for completion of sends +CALL GSTATS(810,0) +IF (ISND > 0) THEN + CALL MPL_WAIT(ISENDREQ(1:ISND),CDSTRING='GATH_GRID_CTL: WAIT') ENDIF +CALL GSTATS(810,1) + +!Synchronize processors. Useful ?? +CALL GSTATS(785,0) +!rekCALL MPL_BARRIER(CDSTRING='GATH_SPEC_CONTROL:') +CALL GSTATS(785,1) + +CALL GSTATS_BARRIER(788) ! ------------------------------------------------------------------ END SUBROUTINE GATH_SPEC_CONTROL END MODULE GATH_SPEC_CONTROL_MOD - -