SUBROUTINE SLCOMM2(KASLB1,KSLPROCS,KSLRPT,&
 & KSLSPT,KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM,&
 & KFIXFLD,KMASK1,KMASK2,&
 & KFLDSLB,LDINC,PB1A,LDSLCOMM)  
!****-------------------------------------------------------------------
!**** *SLCOMM2* - Interpolation buffer communication
!****-------------------------------------------------------------------
!     Purpose.
!     --------
!           This routine is called to perform the inter-processor 
!     communication required for schemes needing horizontal interpolations.

!**   Interface.
!     ----------
!        *CALL* *SLCOMM2

!        Explicit arguments :
!        --------------------
!        INPUT:
!          KASLB1         - local inner dimension of interpolation buffer.
!          KSLPROCS       - number of processors to communicate with.
!          KSLRPT         - dimension for KSLRECVPOS.
!          KSLSPT         - dimension for KSLSENDPOS.
!          KSLSENDPOS     - the addresses within the interpolation buffer 
!                           of point sent from this PE.
!          KSLRECVPOS     - the addresses within the interpolation buffer 
!                           of point received on this PE.
!          KSENDPTR       - pointer to the first point for each of the PE's 
!                           that has to receive interpolation halo-data from 
!                           this. Used for addressing KSLSENDPOS().
!          KRECVPTR       - pointer to the first point for each of the PE's 
!                           that are sending interpolation halo-data to this PE.
!                           Used for addressing KSLRECVPOS().
!          KSLCOMM        - interpolation buffer communication: list of the
!                           processors this processor has to communicate with.
!          KFLDSLB        - number of fields in interpolation buffer.
!          KFIXFLD        - description of 'fixed' fields. (fields not sent/
!                           received)
!          KMASK1         - Mask1 for on demand-comms
!          KMASK2         - Mask2 for on demand-comms
!          LDINC          - increment flag for interpolation buffer
!          LDSLCOMM       - Optional: flag indicating whether this processor needs to
!                           communicate with a specific processor.
!        INPUT/OUTPUT:
!          PB1A           - interpolation buffer.

!        Implicit arguments :  None.
!        --------------------

!     Method.
!     -------
!       Copy of SLCOMM for 'on demand' Semi-Lagrangian Communications

!     Externals.
!     ----------
!        MPL_BARRIER,  MPL_SEND, MPL_RECV, MPL_WAIT
!                                   - Communication Interface

!        Is called by SCAN2M, SCAN2MTL, CPCLIMO, CPCLIMI, FPMODPREC

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Deborah Salmond

!     Modifications
!     -------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!        00-09-01  D.Dent:  conversion from MPE to MPL
!        01-11-23  Deborah Salmond  LIMP_NOOLAP Option for non-overlapping 
!                                    message passing and buffer packing
!        26-05-02  Deborah Salmond  Memory save for LIMP_NOOLAP
!        02-10-01  G.Mozdzynski     support for radiation on-demand comms
!        03-01-07  Deborah Salmond  Tidy up
!        G.Mozdzynski  10-Nov-2005 Optimised OpenMP parallelisation
!        G.Mozdzynski  01-Jan-2008 Cleanup
!        G.Mozdzynski  02-Jan-2009 use non-blocking recv and send
!        G.Mozdzynski  27-Jul-2009 Optimise SL communications (LDSLCOMM)
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMLUN   , ONLY : NULOUT
USE YOMMP    , ONLY : NPRCIDS
USE YOMTAG   , ONLY : MTAGSLAG
USE YOMVAR   , ONLY : NSIM4D
USE YOMSLREP , ONLY : LSLADREP

USE MPL_MODULE

IMPLICIT NONE

!     DUMMY:
INTEGER(KIND=JPIM),INTENT(IN)    :: KASLB1 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLPROCS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLRPT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLSPT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDSLB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLSENDPOS(KSLSPT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLRECVPOS(KSLRPT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSENDPTR(KSLPROCS+1) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KRECVPTR(KSLPROCS+1) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLCOMM(KSLPROCS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIXFLD(2) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMASK1(KASLB1+4) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KMASK2(KASLB1+4) 
LOGICAL           ,INTENT(IN)    :: LDINC 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB1A(KASLB1,KFLDSLB) 
LOGICAL,OPTIONAL  ,INTENT(IN)    :: LDSLCOMM(KSLPROCS)
REAL(KIND=JPRB),ALLOCATABLE :: ZSENDBUF(:),ZRECVBUF(:)
REAL(KIND=JPRB) :: ZDUM(2)

INTEGER(KIND=JPIM) :: IRECVMAP(0:KSLRPT,KSLPROCS)
INTEGER(KIND=JPIM) :: ISENDMAP(0:KSLSPT,KSLPROCS)

INTEGER(KIND=JPIM) :: ISENDTOT (KSLPROCS)
INTEGER(KIND=JPIM) :: IRECVTOT (KSLPROCS)
INTEGER(KIND=JPIM) :: IREQ     (KSLPROCS*2)
INTEGER(KIND=JPIM) :: JPOS     (KSLPROCS)
INTEGER(KIND=JPIM) :: JSEND    (KSLPROCS)
INTEGER(KIND=JPIM) :: ISEND_POS(KSLPROCS)
INTEGER(KIND=JPIM) :: IRECV_POS(KSLPROCS)
INTEGER(KIND=JPIM) :: ILENB    (KSLPROCS)
LOGICAL            :: LLSLCOMM (KSLPROCS)
INTEGER(KIND=JPIM) :: IFIXFLD(2)
INTEGER(KIND=JPIM) :: IDUM(2)

INTEGER(KIND=JPIM) :: IBEG, IEND, ILEN, &
 & IPT, IRECVPROC, ISENDPROC, &
 & ITAG, J, JFLD, JNUM, ITOT,  INUMFIELDS, &
 & JR, JS, INUMSENT, JJ,JM, I_KPOS, IR

INTEGER(KIND=JPIM) :: ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM),ALLOCATABLE :: IPTA(:,:)

LOGICAL :: LLCOMMDBGL
INTEGER(KIND=JPIM) :: I_MAPSENDTOT, I_MAPRECVTOT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('SLCOMM2',0,ZHOOK_HANDLE)


IFIXFLD(1)=KFIXFLD(1)
IFIXFLD(2)=KFIXFLD(2)

JR=0
JS=0
INUMSENT=0
ISENDCOUNT=0
IRECVCOUNT=0
INUMFIELDS=KFLDSLB-IFIXFLD(2)+IFIXFLD(1)-1

DO J=1,KSLPROCS
  ISENDTOT(J)=KSENDPTR(J+1)-KSENDPTR(J)
  IRECVTOT(J)=KRECVPTR(J+1)-KRECVPTR(J)
  IF(ISENDTOT(J) > 0 ) THEN
    JS=JS+1
  ENDIF
  IF(IRECVTOT(J) > 0 ) THEN
    JR=JR+1
  ENDIF
  ISENDCOUNT=MAX(ISENDCOUNT,ISENDTOT(J))
  IRECVCOUNT=MAX(IRECVCOUNT,IRECVTOT(J))
ENDDO

ITAG=MTAGSLAG

LLCOMMDBGL=.FALSE.

IF( LLCOMMDBGL )THEN
  DO J=1,KSLPROCS
    WRITE(NULOUT,'("SLCOMM2: J,KSLCOMM(J),ISENDTOT(J),",&
     & "IRECVTOT(J)=",4I6)')J,KSLCOMM(J),ISENDTOT(J),IRECVTOT(J)  
    CALL FLUSH(NULOUT)
  ENDDO
ENDIF

DO J=1,KSLPROCS
  IF(PRESENT(LDSLCOMM))THEN
    IF(NSIM4D > 0)THEN
      LLSLCOMM(J)=LDSLCOMM(J)
    ELSE
      LLSLCOMM(J)=.TRUE.
    ENDIF
    IF( LSLADREP ) LLSLCOMM(J)=.TRUE.
  ELSE
    LLSLCOMM(J)=.TRUE.
  ENDIF
ENDDO

IF(.NOT.LDINC)THEN
  DO IPT=KASLB1,1,-1
    IF(KMASK2(IPT) == 4) THEN
      KMASK2(IPT  )=1
      KMASK2(IPT+1)=1
      KMASK2(IPT+2)=1
      KMASK2(IPT+3)=1
    ENDIF
  ENDDO
ENDIF

CALL GSTATS_BARRIER(759)
CALL GSTATS(501,0)
IF(LDINC)THEN
  DO J=1,KSLPROCS
    ITOT=0
    IBEG=KSENDPTR(J)
    IEND=KSENDPTR(J+1)-1
    DO JNUM=IBEG,IEND
      IPT=KSLSENDPOS(JNUM)
      ISENDMAP(JNUM-IBEG+1,J)= KMASK1(IPT)
      IF(KMASK1(IPT) == 1)ITOT=ITOT+1
    ENDDO
    ISENDMAP(0,J)=ITOT
    IF(ISENDMAP(0,J) == 0) ISENDTOT(J)=0
  ENDDO
  IR=0
  DO J=1,KSLPROCS
    IRECVMAP(0,J)=0
    IF( LLSLCOMM(J) )THEN
      IR=IR+1
      IRECVPROC=KSLCOMM(J)
      ILEN=(KRECVPTR(J+1)-KRECVPTR(J))
      CALL MPL_RECV(IRECVMAP(0:ILEN,J),KSOURCE=NPRCIDS(IRECVPROC),KTAG=ITAG, &
       & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
       & CDSTRING='SLCOMM2: RECV MAP ' )  
    ENDIF
  ENDDO
  DO J=1,KSLPROCS
    IF( LLSLCOMM(J) )THEN
      IR=IR+1
      ISENDPROC=KSLCOMM(J)
      ILEN=(KSENDPTR(J+1)-KSENDPTR(J))
      CALL MPL_SEND(ISENDMAP(0:ILEN,J),KDEST=NPRCIDS(ISENDPROC),KTAG=ITAG, &
       & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
       & CDSTRING='SLCOMM2: SEND MAP ' )  
    ENDIF
  ENDDO
  IF( IR > 0 )THEN
    CALL MPL_WAIT(IDUM,KREQUEST=IREQ(1:IR), &
     & CDSTRING='SLCOMM2: WAIT FOR MAP SENDS AND RECEIVES')  
  ENDIF
  DO J=1,KSLPROCS
    IF(IRECVMAP(0,J) == 0) IRECVTOT(J)=0
  ENDDO
  
ELSE ! LDINC
  
  DO J=1,KSLPROCS
    ITOT=0
    ISENDPROC=KSLCOMM(J)
    IBEG=KRECVPTR(J)
    IEND=KRECVPTR(J+1)-1
    DO JNUM=IBEG,IEND
      IPT=KSLRECVPOS(JNUM)
      IRECVMAP(JNUM-IBEG+1,J)= KMASK2(IPT)
      IF(KMASK2(IPT) == 1)ITOT=ITOT+1
    ENDDO
    IRECVMAP(0,J)=ITOT
    IF(IRECVMAP(0,J) == 0) IRECVTOT(J)=0 
  ENDDO
  IR=0
  DO J=1,KSLPROCS
    ISENDMAP(0,J)=0
    IF( LLSLCOMM(J) )THEN
      IR=IR+1
      IRECVPROC=KSLCOMM(J)
      ILEN=(KSENDPTR(J+1)-KSENDPTR(J))
      CALL MPL_RECV(ISENDMAP(0:ILEN,J),KSOURCE=NPRCIDS(IRECVPROC),KTAG=ITAG,&
       & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
       & CDSTRING='SLCOMM2: RECV MAP ' )  
    ENDIF
  ENDDO
  DO J=1,KSLPROCS
    IF( LLSLCOMM(J) )THEN
      IR=IR+1
      ISENDPROC=KSLCOMM(J)
      ILEN=(KRECVPTR(J+1)-KRECVPTR(J))
      CALL MPL_SEND(IRECVMAP(0:ILEN,J),KDEST=NPRCIDS(ISENDPROC),KTAG=ITAG, &
       & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
       & CDSTRING='SLCOMM2: SEND MAP ' )  
    ENDIF
  ENDDO
  IF( IR > 0 )THEN
    CALL MPL_WAIT(IDUM,KREQUEST=IREQ(1:IR), &
     & CDSTRING='SLCOMM2: ERROR IN MPL_WAIT FOR MAP')  
   ENDIF
  DO J=1,KSLPROCS
    IF(ISENDMAP(0,J) == 0) ISENDTOT(J)=0 
  ENDDO

ENDIF ! LDINC
CALL GSTATS(501,1)
CALL GSTATS_BARRIER2(759)

ISEND_POS(1)=0
IRECV_POS(1)=0

DO J=2,KSLPROCS
  ISEND_POS(J)=ISEND_POS(J-1)+ISENDMAP(0,J-1)*INUMFIELDS+1
  IRECV_POS(J)=IRECV_POS(J-1)+IRECVMAP(0,J-1)*INUMFIELDS+1
ENDDO

I_MAPSENDTOT=ISEND_POS(KSLPROCS)+ISENDMAP(0,KSLPROCS)*INUMFIELDS
I_MAPRECVTOT=IRECV_POS(KSLPROCS)+IRECVMAP(0,KSLPROCS)*INUMFIELDS

!     Determine the maximum number of grid columns that can be communicated

IF (I_MAPSENDTOT > 0 ) ALLOCATE (ZSENDBUF(0:I_MAPSENDTOT))
IF (I_MAPRECVTOT > 0 ) ALLOCATE (ZRECVBUF(0:I_MAPRECVTOT))



!     Loop over the number of processors we need to communicate with

ITAG=ITAG+1

!       Pack loop.............................................................

CALL GSTATS(1220,0)

ALLOCATE(IPTA(MAX(ISENDCOUNT,IRECVCOUNT),KSLPROCS))
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(J,IRECVPROC,IBEG,IEND,JM,JNUM)
DO J=1,KSLPROCS
  IF( ISENDTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
    IRECVPROC=KSLCOMM(J)
    IBEG=KSENDPTR(J)
    IEND=KSENDPTR(J+1)-1
    JM=0
    DO JNUM=IBEG,IEND
      IF(ISENDMAP((JNUM-KSENDPTR(J)+1),J) == 1)THEN
        JM=JM+1
        IPTA(JM,J)=KSLSENDPOS(JNUM)
      ENDIF
    ENDDO
    ILENB(J)=JM
    JPOS(J)=(KFLDSLB-(IFIXFLD(2)-IFIXFLD(1)+1))*JM
    JSEND(J)=NPRCIDS(IRECVPROC)
    ZSENDBUF(ISEND_POS(J))=ISENDTOT(J)
    IF( LLCOMMDBGL )THEN
      WRITE(NULOUT,'("SLCOMM2: SENDING ",I6," TO ",I6,&
       & " ITAG=",I9)')ISENDTOT(J),IRECVPROC,ITAG
      CALL FLUSH(NULOUT)
    ENDIF
  ENDIF
ENDDO
!$OMP END PARALLEL DO

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,J,ILEN,I_KPOS,JJ)
DO JFLD=1,IFIXFLD(1)-1
  DO J=1,KSLPROCS
    IF( ISENDTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
      ILEN=ILENB(J)
      I_KPOS=ISEND_POS(J)+(JFLD-1)*ILEN
      DO JJ=1,ILEN
        ZSENDBUF(I_KPOS+JJ)=PB1A(IPTA(JJ,J),JFLD)
      ENDDO
    ENDIF
  ENDDO
ENDDO
!$OMP END PARALLEL DO

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,J,ILEN,I_KPOS,JJ)
DO JFLD=IFIXFLD(2)+1,KFLDSLB
  DO J=1,KSLPROCS
    IF( ISENDTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
      ILEN=ILENB(J)
      I_KPOS=ISEND_POS(J)+(IFIXFLD(1)-IFIXFLD(2)+JFLD-2)*ILEN
      DO JJ=1,ILEN
        ZSENDBUF(I_KPOS+JJ)=PB1A(IPTA(JJ,J),JFLD)
      ENDDO
    ENDIF
  ENDDO
ENDDO
!$OMP END PARALLEL DO
  DEALLOCATE(IPTA)

CALL GSTATS(1220,1)


IR=0
CALL GSTATS_BARRIER(748)
CALL GSTATS(511,0)

!       Receive loop.........................................................
DO J=1,KSLPROCS
  IF( IRECVTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
    IR=IR+1
    ISENDPROC=KSLCOMM(J)
    IF( LLCOMMDBGL )THEN
      WRITE(NULOUT,'("SLCOMM2: RECEIVING ",I6," FROM ",I6,&
       & " ITAG=",I9)')ISENDPROC,ITAG  
      CALL FLUSH(NULOUT)
    ENDIF
    ILEN=IRECVMAP(0,J)*INUMFIELDS
    CALL MPL_RECV(ZRECVBUF(IRECV_POS(J):IRECV_POS(J)+ILEN), &
     & KSOURCE=NPRCIDS(ISENDPROC), &
     & KTAG=ITAG,&
     & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
     & CDSTRING='SLCOMM2: RECV' )  
  ENDIF
ENDDO

!       Send loop.............................................................
DO J=1,KSLPROCS
  IF( ISENDTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
    IR=IR+1
    CALL MPL_SEND(ZSENDBUF(ISEND_POS(J):ISEND_POS(J)+JPOS(J)),&
     & KDEST=JSEND(J),KTAG=ITAG, &
     & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
     & CDSTRING='SLCOMM2: SEND ' )  
  ENDIF
ENDDO

!       Wait for all outstanding sends

IF(IR > 0) THEN
  CALL MPL_WAIT(ZDUM,KREQUEST=IREQ(1:IR), &
   & CDSTRING='SLCOMM2: WAIT FOR SENDS AND RECEIVES')  
ENDIF

CALL GSTATS(511,1)
CALL GSTATS_BARRIER2(748)

!     Unpack loop.............................................................
CALL GSTATS(1221,0)

ALLOCATE(IPTA(MAX(ISENDCOUNT,IRECVCOUNT),KSLPROCS))
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(J,ISENDPROC,IBEG,IEND,JM,JNUM)
DO J=1,KSLPROCS
  IF( IRECVTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
    ISENDPROC=KSLCOMM(J)
    IBEG=KRECVPTR(J)
    IEND=KRECVPTR(J)+ZRECVBUF(IRECV_POS(J))-1
    JM=0
    DO JNUM=IBEG,IEND
      IF(IRECVMAP((JNUM-KRECVPTR(J)+1),J) == 1)THEN
        JM=JM+1
        IPTA(JM,J)=KSLRECVPOS(JNUM)
      ENDIF
    ENDDO
    ILENB(J)=JM
    IF( LLCOMMDBGL )THEN
      WRITE(NULOUT,'("SLCOMM2: SENDING ",I6," TO ",I6,&
       & " ITAG=",I9)')ISENDTOT(J),IRECVPROC,ITAG
      CALL FLUSH(NULOUT)
    ENDIF
  ENDIF
ENDDO
!$OMP END PARALLEL DO

IF( LDINC )THEN
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,J,ILEN,I_KPOS,JJ)
  DO JFLD=1,IFIXFLD(1)-1
    DO J=1,KSLPROCS
      IF( IRECVTOT(J) > 0 )THEN
        ILEN=ILENB(J)
        I_KPOS=IRECV_POS(J)+(JFLD-1)*ILEN
        DO JJ=1,ILEN
          PB1A(IPTA(JJ,J),JFLD)=PB1A(IPTA(JJ,J),JFLD)+ZRECVBUF(I_KPOS+JJ)
        ENDDO
      ENDIF
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,J,ILEN,I_KPOS,JJ)
  DO JFLD=IFIXFLD(2)+1,KFLDSLB
    DO J=1,KSLPROCS
      IF( IRECVTOT(J) > 0 )THEN
        ILEN=ILENB(J)
        I_KPOS=IRECV_POS(J)+(IFIXFLD(1)-IFIXFLD(2)+JFLD-2)*ILEN
        DO JJ=1,ILEN
          PB1A(IPTA(JJ,J),JFLD)=PB1A(IPTA(JJ,J),JFLD)+ZRECVBUF(I_KPOS+JJ)
        ENDDO
      ENDIF
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
ELSE
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,J,ILEN,I_KPOS,JJ)
  DO JFLD=1,IFIXFLD(1)-1
    DO J=1,KSLPROCS
      IF( IRECVTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
        ILEN=ILENB(J)
        I_KPOS=IRECV_POS(J)+(JFLD-1)*ILEN
        DO JJ=1,ILEN
          PB1A(IPTA(JJ,J),JFLD)=ZRECVBUF(I_KPOS+JJ)
        ENDDO
      ENDIF
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,J,ILEN,I_KPOS,JJ)
  DO JFLD=IFIXFLD(2)+1,KFLDSLB
    DO J=1,KSLPROCS
      IF( IRECVTOT(J) > 0 .AND. LLSLCOMM(J) )THEN
        ILEN=ILENB(J)
        I_KPOS=IRECV_POS(J)+(IFIXFLD(1)-IFIXFLD(2)+JFLD-2)*ILEN
        DO JJ=1,ILEN
          PB1A(IPTA(JJ,J),JFLD)=ZRECVBUF(I_KPOS+JJ)
        ENDDO
      ENDIF
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
ENDIF

DEALLOCATE(IPTA)

CALL GSTATS(1221,1)
IF (ALLOCATED(ZSENDBUF)) DEALLOCATE (ZSENDBUF)
IF (ALLOCATED(ZRECVBUF)) DEALLOCATE (ZRECVBUF)

IF (LHOOK) CALL DR_HOOK('SLCOMM2',1,ZHOOK_HANDLE)

END SUBROUTINE SLCOMM2

