MODULE TRLTOG_MOD
CONTAINS
SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,&
 &PGP,PGPUV,PGP3A,PGP3B,PGP2)

!**** *trltog * - transposition of grid point data from latitudinal
!                 to column structure. This takes place between inverse
!                 FFT and grid point calculations.
!                 TRLTOG is the inverse of TRGTOL

!     Purpose.
!     --------


!**   Interface.
!     ----------
!        *call* *trltog(...)

!        Explicit arguments :
!        --------------------
!           PGLAT    -  Latitudinal data ready for direct FFT (input)
!           PGP    -  Blocked grid point data    (output)
!           KVSET    - "v-set" for each field      (input)

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

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

!     Author.
!     -------
!        MPP Group *ECMWF*

!     Modifications.
!     --------------
!        Original  : 95-10-01
!        D.Dent    : 97-08-04 Reorganisation to allow NPRTRV
!                             to differ from NPRGPEW
!        =99-03-29= Mats Hamrud and Deborah Salmond
!                   JUMP in FFT's changed to 1
!                   INDEX introduced and ZCOMBUF not used for same PE
!         01-11-23  Deborah Salmond and John Hague
!                   LIMP_NOOLAP Option for non-overlapping message passing 
!                               and buffer packing
!         01-12-18  Peter Towers
!                   Improved vector performance of LTOG_PACK,LTOG_UNPACK
!         03-0-02   G. Radnoti: Call barrier always when nproc>1
!         08-01-01  G.Mozdzynski: cleanup
!         09-01-02  G.Mozdzynski: use non-blocking recv and send
!     ------------------------------------------------------------------



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

USE MPL_MODULE

USE TPM_GEN
USE TPM_DISTR
USE TPM_TRANS

USE INIGPTR_MOD
USE PE2SET_MOD
USE MYSENDSET_MOD
USE MYRECVSET_MOD
USE ABORT_TRANS_MOD

IMPLICIT NONE


REAL(KIND=JPRB),INTENT(IN)     :: PGLAT(:,:)
INTEGER(KIND=JPIM),INTENT(IN)  :: KVSET(:)
INTEGER(KIND=JPIM),INTENT(IN)  :: KF_FS,KF_GP
INTEGER(KIND=JPIM),INTENT(IN)  :: KF_SCALARS_G
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)     :: PGP(:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)     :: PGPUV(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)     :: PGP3A(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)     :: PGP3B(:,:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)     :: PGP2(:,:,:)

! LOCAL VARIABLES

REAL(KIND=JPRB),ALLOCATABLE :: ZCOMBUFS(:,:),ZCOMBUFR(:,:)
REAL(KIND=JPRB) :: ZDUM(2)

INTEGER(KIND=JPIM) :: ISENT    (NPROC)
INTEGER(KIND=JPIM) :: IRCVD    (NPROC)
INTEGER(KIND=JPIM) :: ISENDTOT (NPROC)
INTEGER(KIND=JPIM) :: IRECVTOT (NPROC)
INTEGER(KIND=JPIM) :: IREQ     (NPROC*2)
INTEGER(KIND=JPIM) :: JSEND    (NPROC)
INTEGER(KIND=JPIM) :: JRECV    (NPROC)

INTEGER(KIND=JPIM) :: IFIRST, IFIRSTLAT, IFLD, IGL, IGLL,&
             &ILAST, ILASTLAT, IPOS, ISETA, &
             &ISETB, IRECV, IRECVSET, &
             &ISETV, ISEND, ITAG,  JBLK, JFLD, &
             &JGL, JK, JL, JLOOP, ISETW, IFLDS, IPROC,JROC, &
             &INRECV, INSEND,INR,INS,IR
INTEGER(KIND=JPIM) :: II,INDOFFX,ILEN,IBUFLENS,IBUFLENR

LOGICAL   :: LLPGPUV,LLPGP3A,LLPGP3B,LLPGP2,LLPGPONLY
LOGICAL   :: LLUV(KF_GP),LLGP2(KF_GP),LLGP3A(KF_GP),LLGP3B(KF_GP)
LOGICAL   :: LLDONE, LLINDER
INTEGER(KIND=JPIM) :: IUVLEVS(KF_GP),IUVPARS(KF_GP),IGP2PARS(KF_GP)
INTEGER(KIND=JPIM) :: IGP3APARS(KF_GP),IGP3ALEVS(KF_GP),IGP3BPARS(KF_GP),IGP3BLEVS(KF_GP)
INTEGER(KIND=JPIM) :: IUVPAR,IUVLEV,IGP2PAR,IGP3ALEV,IGP3APAR,IGP3BLEV,IGP3BPAR,IPAROFF
INTEGER(KIND=JPIM) :: IOFF,IOFF1,IOFFNS,IOFFEW,J1,J2
INTEGER(KIND=JPIM) :: INDEX(D%NLENGTF),INDOFF(NPROC),IFLDOFF(KF_FS)
INTEGER(KIND=JPIM) :: IRECV_FLD_START,IRECV_FLD_END
INTEGER(KIND=JPIM) :: ISEND_FLD_START(NPROC),ISEND_FLD_END
INTEGER(KIND=JPIM) :: INUMFLDS
INTEGER(KIND=JPIM) :: IGPTRSEND(2,NGPBLKS,NPRTRNS)
INTEGER(KIND=JPIM) :: IGPTRRECV(NPRTRNS)
INTEGER(KIND=JPIM) :: IGPTROFF(NGPBLKS)

!     INTEGER FUNCTIONS
INTEGER(KIND=JPIM) :: ISENDCOUNT,IRECVCOUNT,J
INTEGER(KIND=JPIM) :: JPOS(NGPBLKS),IFLDA(KF_GP),JI,JJ
INTEGER(KIND=JPIM) :: IFLDT
REAL(KIND=JPRB) :: ZHOOK_HANDLE


!     ------------------------------------------------------------------

!*       0.    Some initializations
!              --------------------
IF (LHOOK) CALL DR_HOOK('TRLTOG',0,ZHOOK_HANDLE)


CALL GSTATS(1806,0)

LLINDER = .FALSE.
LLPGPUV = .FALSE.
LLPGP3A = .FALSE.
LLPGP3B = .FALSE.
LLPGP2  = .FALSE.
LLPGPONLY = .FALSE.
IF(PRESENT(KPTRGP))  LLINDER = .TRUE.
IF(PRESENT(PGP))     LLPGPONLY=.TRUE.
IF(PRESENT(PGPUV))   LLPGPUV=.TRUE.
IF(PRESENT(PGP3A))   LLPGP3A=.TRUE.
IF(PRESENT(PGP3B))   LLPGP3B=.TRUE.
IF(PRESENT(PGP2))    LLPGP2=.TRUE.

IUVPAR=0
IUVLEV=0
IOFF1=0
IOFFNS=KF_SCALARS_G
IOFFEW=2*KF_SCALARS_G

LLUV(:) = .FALSE.
IF (LLPGPUV) THEN
  IOFF=0
  IUVLEV=UBOUND(PGPUV,2)
  IF(LVORGP) THEN
    IUVPAR=IUVPAR+1
    DO J=1,IUVLEV
      IUVLEVS(IOFF+J)=J
      IUVPARS(IOFF+J)=IUVPAR
      LLUV(IOFF+J)=.TRUE.
    ENDDO
    IOFF=IOFF+IUVLEV
  ENDIF
  IF(LDIVGP) THEN
    IUVPAR=IUVPAR+1
    DO J=1,IUVLEV
      IUVLEVS(IOFF+J)=J
      IUVPARS(IOFF+J)=IUVPAR
      LLUV(IOFF+J)=.TRUE.
    ENDDO
    IOFF=IOFF+IUVLEV
  ENDIF
  DO J=1,IUVLEV
    IUVLEVS(IOFF+J)=J
    IUVPARS(IOFF+J)=IUVPAR+1
    IUVLEVS(IOFF+J+IUVLEV)=J
    IUVPARS(IOFF+J+IUVLEV)=IUVPAR+2
  ENDDO
  IUVPAR=IUVPAR+2
  LLUV(IOFF+1:IOFF+2*IUVLEV)=.TRUE.
  IOFF=IOFF+2*IUVLEV
  IOFF1=IOFF
  IOFFNS=IOFFNS+IOFF
  IOFFEW=IOFFEW+IOFF

  IOFF=IUVPAR*IUVLEV+KF_SCALARS_G
  IF(LUVDER) THEN
    IF(LSCDERS) IOFF=IOFF+KF_SCALARS_G
    DO J=1,IUVLEV
      IUVLEVS(IOFF+J)=J
      IUVPARS(IOFF+J)=IUVPAR+1
      LLUV(IOFF+J)=.TRUE.
      IUVLEVS(IOFF+J+IUVLEV)=J
      IUVPARS(IOFF+J+IUVLEV)=IUVPAR+2
      LLUV(IOFF+J+IUVLEV)=.TRUE.
    ENDDO
    IUVPAR=IUVPAR+2
    IOFF=IOFF+2*IUVLEV
    IOFFEW=IOFFEW+2*IUVLEV
  ENDIF
ENDIF

LLGP2(:)=.FALSE.
IF(LLPGP2) THEN
  IOFF=IOFF1
  IGP2PAR=UBOUND(PGP2,2)
  IF(LSCDERS) IGP2PAR=IGP2PAR/3
  DO J=1,IGP2PAR
    LLGP2(J+IOFF) = .TRUE.
    IGP2PARS(J+IOFF)=J
  ENDDO
  IOFF1=IOFF1+IGP2PAR
  IF(LSCDERS) THEN
    IOFF=IOFFNS
    DO J=1,IGP2PAR
      LLGP2(J+IOFF) = .TRUE.
      IGP2PARS(J+IOFF)=J+IGP2PAR
    ENDDO
    IOFFNS=IOFF+IGP2PAR
    IOFF=IOFFEW
    DO J=1,IGP2PAR
      LLGP2(J+IOFF) = .TRUE.
      IGP2PARS(J+IOFF)=J+2*IGP2PAR
    ENDDO
    IOFFEW=IOFF+IGP2PAR
  ENDIF
ENDIF

LLGP3A(:) = .FALSE.
IF(LLPGP3A) THEN
  IGP3ALEV=UBOUND(PGP3A,2)
  IGP3APAR=UBOUND(PGP3A,3)
  IF(LSCDERS) IGP3APAR=IGP3APAR/3
  IOFF=IOFF1
  DO J1=1,IGP3APAR
    DO J2=1,IGP3ALEV
      LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE.
      IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1
      IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2
    ENDDO
  ENDDO
  IPAROFF=IGP3APAR
  IOFF1=IOFF1+IGP3APAR*IGP3ALEV
  IF(LSCDERS) THEN
    IOFF=IOFFNS
    DO J1=1,IGP3APAR
      DO J2=1,IGP3ALEV
        LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE.
        IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1+IPAROFF
        IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2
      ENDDO
    ENDDO
    IPAROFF=IPAROFF+IGP3APAR
    IOFFNS=IOFFNS+IGP3APAR*IGP3ALEV
    IOFF=IOFFEW
    DO J1=1,IGP3APAR
      DO J2=1,IGP3ALEV
        LLGP3A(J2+(J1-1)*IGP3ALEV+IOFF) = .TRUE.
        IGP3APARS(J2+(J1-1)*IGP3ALEV+IOFF)=J1+IPAROFF
        IGP3ALEVS(J2+(J1-1)*IGP3ALEV+IOFF)=J2
      ENDDO
    ENDDO
    IOFFEW=IOFFEW+IGP3APAR*IGP3ALEV
  ENDIF
ENDIF

LLGP3B(:) = .FALSE.
IF(LLPGP3B) THEN
  IGP3BLEV=UBOUND(PGP3B,2)
  IGP3BPAR=UBOUND(PGP3B,3)
  IF(LSCDERS) IGP3BPAR=IGP3BPAR/3
  IOFF=IOFF1
  DO J1=1,IGP3BPAR
    DO J2=1,IGP3BLEV
      LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE.
      IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1
      IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2
    ENDDO
  ENDDO
  IPAROFF=IGP3BPAR
  IOFF1=IOFF1+IGP3BPAR*IGP3BLEV
  IF(LSCDERS) THEN
    IOFF=IOFFNS
    DO J1=1,IGP3BPAR
      DO J2=1,IGP3BLEV
        LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE.
        IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1+IPAROFF
        IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2
      ENDDO
    ENDDO
    IPAROFF=IPAROFF+IGP3BPAR
    IOFFNS=IOFFNS+IGP3BPAR*IGP3BLEV
    IOFF=IOFFEW
    DO J1=1,IGP3BPAR
      DO J2=1,IGP3BLEV
        LLGP3B(J2+(J1-1)*IGP3BLEV+IOFF) = .TRUE.
        IGP3BPARS(J2+(J1-1)*IGP3BLEV+IOFF)=J1+IPAROFF
        IGP3BLEVS(J2+(J1-1)*IGP3BLEV+IOFF)=J2
      ENDDO
    ENDDO
    IOFFEW=IOFFEW+IGP3BPAR*IGP3BLEV
  ENDIF
ENDIF  

CALL INIGPTR(IGPTRSEND,IGPTRRECV)
LLDONE = .FALSE.
ITAG   = MTAGLG

INDOFFX  = 0
IBUFLENS = 0
IBUFLENR = 0
INRECV = 0
INSEND = 0

DO JROC=1,NPROC

  CALL PE2SET(JROC,ISETA,ISETB,ISETW,ISETV)
  ISEND      = JROC
  ISENT(JROC) = 0
  IRCVD(JROC) = 0

!             count up expected number of fields
  IPOS = 0
  DO JFLD=1,KF_GP
    IF(KVSET(JFLD) == ISETV .OR. KVSET(JFLD) == -1) IPOS = IPOS+1
  ENDDO
  IRECVTOT(JROC) = IGPTRRECV(ISETW)*IPOS
  IF(IRECVTOT(JROC) > 0 .AND. MYPROC /= JROC) THEN
    INRECV = INRECV + 1
    JRECV(INRECV)=JROC
  ENDIF

  IF( JROC /= MYPROC) IBUFLENR = MAX(IBUFLENR,IRECVTOT(JROC))

  IFIRSTLAT = MAX(D%NPTRLS(MYSETW),D%NFRSTLAT(ISETA))
  ILASTLAT  = MIN(D%NPTRLS(MYSETW)+D%NULTPP(MYSETW)-1,D%NLSTLAT(ISETA))

  IPOS = 0
  DO JGL=IFIRSTLAT,ILASTLAT
    IGL  = D%NPTRFRSTLAT(ISETA)+JGL-D%NFRSTLAT(ISETA)
    IPOS = IPOS+D%NONL(IGL,ISETB)
  ENDDO

  ISENDTOT(JROC) = IPOS*KF_FS
  IF( JROC /= MYPROC) THEN
    IBUFLENS = MAX(IBUFLENS,ISENDTOT(JROC))
    IF(ISENDTOT(JROC) > 0) THEN
      INSEND = INSEND+1
      JSEND(INSEND)=JROC
    ENDIF
  ENDIF

  IF(IPOS > 0) THEN
    INDOFF(JROC) = INDOFFX
    INDOFFX = INDOFFX+IPOS
    IPOS = 0
    DO JGL=IFIRSTLAT,ILASTLAT
      IGL  = D%NPTRFRSTLAT(ISETA)+JGL-D%NFRSTLAT(ISETA)
      IGLL = JGL-D%NPTRLS(MYSETW)+1
      DO JL=D%NSTA(IGL,ISETB)+D%NSTAGTF(IGLL),&
       &D%NSTA(IGL,ISETB)+D%NSTAGTF(IGLL)+D%NONL(IGL,ISETB)-1
        IPOS = IPOS+1
        INDEX(IPOS+INDOFF(JROC)) = JL
      ENDDO
    ENDDO
  ENDIF
ENDDO

ISENDCOUNT=0
IRECVCOUNT=0
DO J=1,NPROC
  ISENDCOUNT=MAX(ISENDCOUNT,ISENDTOT(J))
  IRECVCOUNT=MAX(IRECVCOUNT,IRECVTOT(J))
ENDDO
IF (IBUFLENS > 0) ALLOCATE(ZCOMBUFS(-1:ISENDCOUNT,INSEND))
IF (IBUFLENR > 0) ALLOCATE(ZCOMBUFR(-1:IRECVCOUNT,INRECV))

CALL GSTATS(1806,1)


! Copy local contribution
IF( IRECVTOT(MYPROC) > 0 )THEN
  IFLDS = 0
  DO JFLD=1,KF_GP
    IF(KVSET(JFLD) == MYSETV .OR. KVSET(JFLD) == -1) THEN
      IFLDS = IFLDS+1
      IF(LLINDER) THEN
        IFLDOFF(IFLDS) = KPTRGP(JFLD)
      ELSE
        IFLDOFF(IFLDS) = JFLD
      ENDIF
    ENDIF
  ENDDO

  IPOS=0
  DO JBLK=1,NGPBLKS
    IGPTROFF(JBLK)=IPOS
    IFIRST = IGPTRSEND(1,JBLK,MYSETW)
    IF(IFIRST > 0) THEN
      ILAST = IGPTRSEND(2,JBLK,MYSETW)
      IPOS=IPOS+ILAST-IFIRST+1
    ENDIF
  ENDDO

  CALL GSTATS(1604,0)
#ifdef NECSX 
!$OMP PARALLEL DO SCHEDULE(DYNAMIC) PRIVATE(JFLD,JBLK,JK,IFLD,IPOS,IFIRST,ILAST)
#else
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JBLK,JK,IFLD,IPOS,IFIRST,ILAST)
#endif
  DO JBLK=1,NGPBLKS
    IFIRST = IGPTRSEND(1,JBLK,MYSETW)
    IF(IFIRST > 0) THEN
      ILAST = IGPTRSEND(2,JBLK,MYSETW)
      IF(LLPGPONLY) THEN
        DO JFLD=1,IFLDS
          IFLD = IFLDOFF(JFLD)
          DO JK=IFIRST,ILAST
            IPOS = INDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1
            PGP(JK,IFLD,JBLK) = PGLAT(JFLD,INDEX(IPOS))
          ENDDO
        ENDDO
      ELSE
        DO JFLD=1,IFLDS
          IFLD = IFLDOFF(JFLD)
          IF(LLUV(IFLD)) THEN
            DO JK=IFIRST,ILAST
              IPOS = INDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1
              PGPUV(JK,IUVLEVS(IFLD),IUVPARS(IFLD),JBLK) = PGLAT(JFLD,INDEX(IPOS))
            ENDDO
          ELSEIF(LLGP2(IFLD)) THEN
            DO JK=IFIRST,ILAST
              IPOS = INDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1
              PGP2(JK,IGP2PARS(IFLD),JBLK)=PGLAT(JFLD,INDEX(IPOS))
            ENDDO
          ELSEIF(LLGP3A(IFLD)) THEN
            DO JK=IFIRST,ILAST
              IPOS = INDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1
              PGP3A(JK,IGP3ALEVS(IFLD),IGP3APARS(IFLD),JBLK)=PGLAT(JFLD,INDEX(IPOS))
            ENDDO
          ELSEIF(LLGP3B(IFLD)) THEN
            DO JK=IFIRST,ILAST
              IPOS = INDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1
              PGP3B(JK,IGP3BLEVS(IFLD),IGP3BPARS(IFLD),JBLK)=PGLAT(JFLD,INDEX(IPOS))
            ENDDO
          ELSE
            WRITE(NOUT,*)'TRLTOG_MOD: ERROR',JFLD,IFLD
            CALL ABORT_TRANS('TRLTOG_MOD: ERROR')
          ENDIF
        ENDDO
      ENDIF
    ENDIF
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1604,1)

ENDIF

!
! loop over the number of processors we need to communicate with.
! NOT MYPROC
!
!  Pack loop.........................................................

CALL GSTATS(1605,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JL,II,JFLD,INS,ISEND,ILEN,ISEND_FLD_END)
  DO INS=1,INSEND
    ISEND=JSEND(INS)
    ISEND_FLD_START(ISEND)= 1
    ILEN = ISENDTOT(ISEND)/KF_FS
    ISEND_FLD_END = KF_FS
#ifdef NECSX
    DO JFLD=ISEND_FLD_START(ISEND),ISEND_FLD_END
      DO JL=1,ILEN
      II = INDEX(INDOFF(ISEND)+JL)
#else
    DO JL=1,ILEN
      II = INDEX(INDOFF(ISEND)+JL)
      DO JFLD=ISEND_FLD_START(ISEND),ISEND_FLD_END
#endif
        ZCOMBUFS((JFLD-ISEND_FLD_START(ISEND))*ILEN+JL,INS) = PGLAT(JFLD,II)
      ENDDO
    ENDDO
    ZCOMBUFS(-1,INS) = 1
    ZCOMBUFS(0,INS)  = KF_FS
  ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1605,1)

IR=0
CALL GSTATS_BARRIER(762)
CALL GSTATS(805,0)

!...Receive loop.........................................................
DO INR=1,INRECV
  IR=IR+1
  IRECV=JRECV(INR)
  CALL MPL_RECV(ZCOMBUFR(-1:IRECVTOT(IRECV),INR), &
    & KSOURCE=NPRCIDS(IRECV), &
    & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
    & KTAG=ITAG,CDSTRING='TRLTOG:' )
ENDDO

!...Send loop.........................................................
DO INS=1,INSEND
  IR=IR+1
  ISEND=JSEND(INS)
  CALL MPL_SEND(ZCOMBUFS(-1:ISENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),&
       & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ(IR), &
       & KTAG=ITAG,CDSTRING='TRLTOG:')
ENDDO

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

CALL GSTATS(805,1)
CALL GSTATS_BARRIER2(762)

!  Unpack loop.........................................................

CALL GSTATS(1606,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(IFLDT,JBLK,IFIRST,ILAST,JK,&
!$OMP& JJ,JI,JPOS,INR,IRECV,IRECVSET,IRECV_FLD_START,IRECV_FLD_END,IPOS,&
!$OMP& ISETA,ISETB,ISETW,ISETV,JFLD,IFLD,IFLDA)

  DO INR=1,INRECV
    IRECV=JRECV(INR)
    CALL PE2SET(IRECV,ISETA,ISETB,ISETW,ISETV)
    IRECVSET = ISETV
    IRECV_FLD_START = ZCOMBUFR(-1,INR)
    IRECV_FLD_END   = ZCOMBUFR(0,INR)
    IFLD = 0
    IPOS = 0
    DO JFLD=1,KF_GP
      IF(KVSET(JFLD) == IRECVSET .OR. KVSET(JFLD) == -1 ) THEN
        IFLD = IFLD+1
        IFLDA(IFLD)=JFLD
      ENDIF
    ENDDO

    DO JBLK=1,NGPBLKS
      IFIRST = IGPTRSEND(1,JBLK,ISETW)
      IF(IFIRST > 0) THEN
        ILAST = IGPTRSEND(2,JBLK,ISETW)
        JPOS(JBLK)=IPOS
        IPOS=IPOS+(ILAST-IFIRST+1)
      ENDIF
    ENDDO
    
    
    DO JJ=IRECV_FLD_START,IRECV_FLD_END
      IFLDT=IFLDA(JJ)
      DO JBLK=1,NGPBLKS
        IFIRST = IGPTRSEND(1,JBLK,ISETW)
        IF(IFIRST > 0) THEN
          ILAST = IGPTRSEND(2,JBLK,ISETW)
          IF(LLINDER) THEN
            DO JK=IFIRST,ILAST
              JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK)+JK-IFIRST+1
              PGP(JK,KPTRGP(IFLDT),JBLK) = ZCOMBUFR(JI,INR)
            ENDDO
          ELSEIF(LLPGPONLY) THEN
            DO JK=IFIRST,ILAST
              JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK)+JK-IFIRST+1
              PGP(JK,IFLDT,JBLK) = ZCOMBUFR(JI,INR)
            ENDDO
          ELSEIF(LLUV(IFLDT)) THEN
            DO JK=IFIRST,ILAST
              JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK)+JK-IFIRST+1
              PGPUV(JK,IUVLEVS(IFLDT),IUVPARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR)
            ENDDO
          ELSEIF(LLGP2(IFLDT)) THEN
            DO JK=IFIRST,ILAST
              JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK)+JK-IFIRST+1
              PGP2(JK,IGP2PARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR)
            ENDDO
          ELSEIF(LLGP3A(IFLDT)) THEN
            DO JK=IFIRST,ILAST
              JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK)+JK-IFIRST+1
              PGP3A(JK,IGP3ALEVS(IFLDT),IGP3APARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR)
            ENDDO
          ELSEIF(LLGP3B(IFLDT)) THEN
            DO JK=IFIRST,ILAST
              JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK)+JK-IFIRST+1
              PGP3B(JK,IGP3BLEVS(IFLDT),IGP3BPARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR)
            ENDDO
          ENDIF
        ENDIF
      ENDDO
    ENDDO
    
    IPOS=(IRECV_FLD_END-IRECV_FLD_START+1)*IPOS
  ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1606,1)
IF (IBUFLENS > 0) DEALLOCATE(ZCOMBUFS)
IF (IBUFLENR > 0) DEALLOCATE(ZCOMBUFR)

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

END SUBROUTINE TRLTOG
END MODULE TRLTOG_MOD
