SUBROUTINE MPOBSEQ_PACK(&
 & KPROMB,KPROMBMP,KOBTYP,KOBNUM,KOBNUMA,LDMVO5,&
 & PSLU     ,PSLV     ,PSLT     ,PSLGFL ,&
 & PSLEZ    ,PSLEH ,&
 & PSLSP    ,PSLEST   ,PSLU0    ,PSLV0    ,PSLCHN,&
 & PSLTS    ,PSLWS    ,PSLSN    ,PSLZ0    ,PSLWL ,&
 & PSLU10N  ,PSLV10N  , &
 & PSLCORI  ,PSLALBE  ,PSLEMIS  ,PSLLSMA  ,&
 & PSLVEGE  ,&
 & PSLCI    ,PSLCVH   ,PSLCVL   ,PSLTVH   ,PSLTVL,&
 & PSLPRWA  ,PSLPRSN  ,PSLARG   ,PSLSAB   ,&
 & PSLHV    ,PSLZ0H   ,PSLOROG  ,PSLDL    ,PSLDM ,&
 & PSLXTS   ,PSLXSN,&
 & PSLESN   ,PSLET2   ,PSLEH2   ,PSLEV1   ,PSLSST,&
 & PSLTCLS  ,PSLHUCLS ,&
 & YDGOMUA  ,YDGOMS   ,YDGOMUA_2D         ,YDGOMS_2D)

!**** *MPOBSEQ_PACK* Message passing of obs.eq. 

!     Purpose :  Exchange GOM arrays
!     -------

!     Interface : CALL MPOBSEQ_PACK(..)
!     ---------

!       Explicit arguments : KPROMB = number of observations processed in SLINT
!       ------------------   KPROMBMP = number of obs. on my processor (NOBTOT)
!                            KOBTYP(KPROMBMP) = obs types
!                            PSLU etc. - interpolated obs eq.

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

!     Externals :   MPL_RECV - receive message
!     ---------     MPL_SEND - send message

!     Author : Mats Hamrud *ECMWF*
!     ------

!     Modifications :
!     -------------
!     95-12-08 M.Hamrud    Original
!     96-12-01 M.Hamrud    : 4-D var
!     97-02-22 B. Urban    : Added PSLXTS,PSLXWS,PSLXWP,PSLXSN,PSLXTP
!                            (surface climatology for Canari)
!     97-06-02 F.Taillefer : Add DL and DM arrays
!     97-11-17 E.Andersson : Introduce CIW and O3, Flexinle GOM-arrays.
!     97-10-10 F.Taillefer : Add model errors arrays (for Canari)
!     98-07-10 F.Taillefer : Adapt to CANARI (cycle 19 changes)
!     99-08-06 P.Moll      : Pb LOBSTL pour les champs constants 
!     99-09-01 P.Viterbo   : Surface tiles
!     00-09-01 D.Dent      : MPE to MPL conversion
!     02-05-22 F.Taillefer : Add SST array (possible land/sea obs)
!     02-08-01 D. Salmond  : LIMP_NOOLAP Option for non-overlapping
!                            message passing and buffer packing
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     04-06-23 C.Payan     : Control on ZBUFR pointer
!        M.Hamrud      15-Feb-2005 New-style GOM arrays
!     08-07-04 H.Hersbach  : Add surface current and wave Charnock
!     04-12-09 H.Hersbach  : 10-m neutral wind; LUPD
!    -------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB

USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIM   , ONLY : NFLEVG
USE YOMDIMO  , ONLY : NACTIM
USE YOMCT0   , ONLY : NPROC    ,LCANARI  ,LCASIG
USE YOMCT0B  , ONLY : LECMWF
USE YOMCT3   , ONLY : NSTEP
USE YOMLUN   , ONLY : NULERR
USE YOMPHY   , ONLY : LSOLV
USE YOMCOCTP , ONLY : NOOBST
USE YOMGLOBS , ONLY : NOBSSEND ,NSTASEND ,&
 & NTYPSEND ,NSTARECV ,NLOCRECV,NLOCPROF,&
 & LPREMPOBS,SENDBUF,NENDS,SENDBUF5,NENDS5
USE YOMECTAB , ONLY : NTSLOTNO
USE YOMMP    , ONLY : MYPROC
USE YOMVRTL  , ONLY : LOBSTL
USE SURFACE_FIELDS_MIX, ONLY : YDUPD
USE GOMS_MIX     , ONLY : TYPE_GOMUA,TYPE_GOMS,TYPE_GOMUA_2D,TYPE_GOMS_2D,&
 & LGOMUA,YGOMV,YGOMEC,YGOMEC_2D,YGOMCAN,YGOMCANA, &
 & NGOMGFL, LGOMGFL, MGOMGFL
USE YOMDPHY,   ONLY : LDIRCLSMOD

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMBMP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTYP(KPROMBMP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBNUM(KPROMBMP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBNUMA(KPROMBMP) 
LOGICAL           ,INTENT(IN)    :: LDMVO5 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLU(KPROMB,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLV(KPROMB,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLT(KPROMB,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLGFL(KPROMB,NFLEVG,NGOMGFL) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLEZ(KPROMB,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLEH(KPROMB,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLSP(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLU0(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLV0(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLCHN(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLEST(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLTS(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLWS(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLSN(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLZ0(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLWL(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLU10N(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLV10N(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLCORI(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLALBE(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLEMIS(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLLSMA(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLVEGE(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLCI(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLCVH(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLCVL(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLTVH(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLTVL(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLPRWA(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLPRSN(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLARG(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLSAB(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLHV(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLZ0H(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLOROG(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLDL(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLDM(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLXTS(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLXSN(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLESN(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLET2(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLEH2(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLEV1(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLSST(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLTCLS(KPROMB)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLHUCLS(KPROMB)
TYPE(TYPE_GOMUA)  ,INTENT(INOUT)   :: YDGOMUA(:) 
TYPE(TYPE_GOMS)   ,INTENT(INOUT)   :: YDGOMS(:) 
TYPE(TYPE_GOMUA_2D)  ,INTENT(INOUT)   :: YDGOMUA_2D(:)
TYPE(TYPE_GOMS_2D)   ,INTENT(INOUT)   :: YDGOMS_2D(:) 

! Local variables

INTEGER(KIND=JPIM) :: IBP, IBUFLENS, &
 & INUM, IOBS, IOBSL, &
 & IOFF, IOFFR, IOFFS, IOFFTS, &
 & ISEND,  ISN, &
 & ITS, ITYP, JLEV, JOBS, JROC, IOBSSEND, &
 & IBUFLENP, ISS, &
 & IPROF,JTYP,JGFL,IGFL,&
 & ISTGFL, IENGFL,ITSLOTB, ITSLOTE,ITSLOTS
             
INTEGER(KIND=JPIM), DIMENSION(NPROC) :: ISTARTS

LOGICAL         :: LLUPD
REAL(KIND=JPRB) :: ZUPD
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!    -------------------------------------------------------------------
!*       1.  SETUPS.
!            ------

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

ITS = NTSLOTNO
IF(LPREMPOBS) THEN
  ITSLOTB = 1
  ITSLOTE = NACTIM
  IF(ITS == 1) THEN
    IF(LDMVO5) THEN
      NENDS5(:)=0
    ELSE
      NENDS(:)=0
    ENDIF
  ENDIF
ELSE
  ITSLOTB = NTSLOTNO
  ITSLOTE = NTSLOTNO
  NENDS(:)=0
  NENDS5(:)=0
ENDIF
ITSLOTS = ITSLOTE-ITSLOTB+1

LLUPD=YDUPD%L_OK
IF (LLUPD) THEN
   ZUPD=1.0_JPRB
ELSE
   ZUPD=0.0_JPRB
ENDIF

!    -------------------------------------------------------------------
!*       2.  EXCHANGE OBS.EQ. WITH OTHER PROCESSORS.
!            --------------------------------------

IOBSSEND = SUM(NOBSSEND(:,ITSLOTB:ITSLOTE))-SUM(NOBSSEND(MYPROC,ITSLOTB:ITSLOTE))

ISN  = 0
DO JTYP=1,NOOBST
  ISN = MAX(ISN,COUNT(LGOMUA(JTYP,:)))
ENDDO
ISN = ISN*NFLEVG

IBUFLENP = ISN+12+5
IF (LECMWF) IBUFLENP = IBUFLENP+4
IF (LDMVO5.OR..NOT.LOBSTL) IBUFLENP=IBUFLENP+8
IF (LDMVO5) IBUFLENP=IBUFLENP+1
IF (LCANARI.AND.LCASIG) IBUFLENP=IBUFLENP+2*NFLEVG+5
IF (LCANARI) IBUFLENP=IBUFLENP+4
IF (LSOLV.AND.(LDMVO5.OR..NOT.LOBSTL)) IBUFLENP=IBUFLENP+4
IF (LDIRCLSMOD) IBUFLENP=IBUFLENP+2        

ISS = 1
DO JROC = 1,NPROC
  IF(JROC /= MYPROC) THEN
    IF(LDMVO5) THEN
      IF(LPREMPOBS .AND.  NENDS5(JROC) > 0) THEN
        ISTARTS(JROC) = NENDS5(JROC)+1
      ELSE
        ISTARTS(JROC) = ISS
      ENDIF
    ELSE
      IF(LPREMPOBS .AND.  NENDS(JROC) > 0) THEN
        ISTARTS(JROC) = NENDS(JROC)+1
      ELSE
        ISTARTS(JROC) = ISS
      ENDIF
    ENDIF
    ISS = ISS+SUM(NOBSSEND(JROC,ITSLOTB:ITSLOTE))*IBUFLENP
  ENDIF
ENDDO

IBUFLENS = IBUFLENP*IOBSSEND
IF(LDMVO5) THEN
  IF(.NOT. ALLOCATED(SENDBUF5)) THEN
    ALLOCATE(SENDBUF5(IBUFLENS))
  ENDIF
ELSE
  IF(.NOT. ALLOCATED(SENDBUF)) THEN
    ALLOCATE(SENDBUF(IBUFLENS))
  ENDIF
ENDIF


!*           PACK SEND BUFFER
!            ----------------

CALL GSTATS(1070,0)
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1)&
!$OMP&PRIVATE(JROC,ISEND,IBP)
DO JROC = 1,NPROC-1
  ISEND = MOD(MYPROC+JROC-1,NPROC)+1
  IF(NOBSSEND(ISEND,ITS) > 0) THEN
    IBP = ISTARTS(ISEND)-1
    IF(LDMVO5) THEN
      CALL PACK_SEND(IBP,ISEND,SENDBUF5)
      NENDS5(ISEND)=IBP
    ELSE
      CALL PACK_SEND(IBP,ISEND,SENDBUF)
      NENDS(ISEND)=IBP
    ENDIF
  ENDIF
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1070,1)

!    ------------------------------------------------------------------
!*       3.  COPY YOUR OWN OBS.EQ. TO RECEIVE ARRAYS
!            ---------------------------------------

IOFFS = NSTASEND(MYPROC,ITS)-NSTASEND(1,ITS) ! Offset within timeslot
IOFFR = NSTARECV(MYPROC,ITS)                 ! Global offset
CALL GSTATS(1073,0)
!$OMP PARALLEL DO SCHEDULE(STATIC)&
!$OMP&PRIVATE(JOBS,IOBSL,IOBS,IPROF,INUM,JGFL,IGFL,ISTGFL,IENGFL)
DO JOBS = 1,NOBSSEND(MYPROC,ITS)
  IOBSL = IOFFS+JOBS
  IOBS = NLOCRECV(IOFFR+JOBS)
  IPROF = NLOCPROF(IOFFR+JOBS)
  INUM = KOBNUM(IOBS)
  IF(IPROF == 0) THEN
    IF(INUM /= YDGOMUA(INUM)%IOBS) THEN
      WRITE(NULERR,*) 'MPOBSEQ_PACK - INUM /= YDGOMUA(INUM)%IOBS 2',&
       & MYPROC,JOBS,INUM,YDGOMUA(INUM)%IOBS
      CALL ABOR1('MPOBSEQ_PACK - INUM /= YDGOMUA(INUM)%IOBS 2')
    ENDIF
    IF(YDGOMUA(INUM)%LU) YDGOMUA(INUM)%U(:) = PSLU(IOBSL,:)
    IF(YDGOMUA(INUM)%LV) YDGOMUA(INUM)%V(:) = PSLV(IOBSL,:)
    IF(YDGOMUA(INUM)%LT) YDGOMUA(INUM)%T(:) = PSLT(IOBSL,:)
    IGFL = 0
    DO JGFL=1,NGOMGFL
      IF(YDGOMUA(INUM)%LGFL(JGFL)) THEN
        IGFL = IGFL+1
        ISTGFL = 1+(IGFL-1)*NFLEVG
        IENGFL = ISTGFL+NFLEVG-1
        YDGOMUA(INUM)%GFL(ISTGFL:IENGFL) = PSLGFL(IOBSL,:,JGFL)
      ENDIF
    ENDDO
  ELSE
    IF(INUM /= YDGOMUA_2D(INUM)%IOBS) THEN
      WRITE(NULERR,*) 'MPOBSEQ_PACK - INUM /= YDGOMUA_2D(INUM)%IOBS 3',&
       & MYPROC,JOBS,INUM,YDGOMUA_2D(INUM)%IOBS
      CALL ABOR1('MPOBSEQ_PACK - INUM /= YDGOMUA(INUM)%IOBS 3')
    ENDIF
    IF(YDGOMUA_2D(INUM)%LU) YDGOMUA_2D(INUM)%U(:,IPROF) = PSLU(IOBSL,:)
    IF(YDGOMUA_2D(INUM)%LV) YDGOMUA_2D(INUM)%V(:,IPROF) = PSLV(IOBSL,:)
    IF(YDGOMUA_2D(INUM)%LT) YDGOMUA_2D(INUM)%T(:,IPROF) = PSLT(IOBSL,:)
    IGFL = 0
    DO JGFL=1,NGOMGFL
      IF(YDGOMUA_2D(INUM)%LGFL(JGFL)) THEN
        IGFL = IGFL+1
        ISTGFL = 1+(IGFL-1)*NFLEVG
        IENGFL = ISTGFL+NFLEVG-1
        YDGOMUA_2D(INUM)%GFL(ISTGFL:IENGFL,IPROF) = PSLGFL(IOBSL,:,JGFL)
      ENDIF
    ENDDO
  ENDIF
ENDDO
!$OMP END PARALLEL DO

!OCL NOVREC
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JOBS,IOBSL,IOBS,IPROF,ITYP,INUM)
DO JOBS = 1,NOBSSEND(MYPROC,ITS)
  IOBSL = IOFFS+JOBS
  IOBS = NLOCRECV(IOFFR+JOBS)
  IPROF = NLOCPROF(IOFFR+JOBS)
  ITYP = KOBTYP(IOBS)
  INUM = KOBNUM(IOBS)

!*             Copy model surface variables
  IF(IPROF == 0) THEN
    YDGOMS(INUM)%UL = PSLU (IOBSL,NFLEVG)
    YDGOMS(INUM)%VL = PSLV (IOBSL,NFLEVG)
    YDGOMS(INUM)%SP = PSLSP(IOBSL)
    YDGOMS(INUM)%TS = PSLTS(IOBSL)
    IF (LDIRCLSMOD) THEN
      YDGOMS(INUM)%TCLS = PSLTCLS(IOBSL)
      YDGOMS(INUM)%HUCLS = PSLHUCLS(IOBSL)
    ENDIF
    YDGOMS(INUM)%WS = PSLWS(IOBSL)
    YDGOMS(INUM)%SN = PSLSN(IOBSL)
    YDGOMS(INUM)%U0 = PSLU0(IOBSL)
    YDGOMS(INUM)%V0 = PSLV0(IOBSL)
    YDGOMS(INUM)%CHN= PSLCHN(IOBSL)
    YDGOMS(INUM)%Z0 = PSLZ0(IOBSL)
    YDGOMS(INUM)%U10N=PSLU10N(IOBSL)
    YDGOMS(INUM)%V10N=PSLV10N(IOBSL)
    YDGOMS(INUM)%WL = PSLWL(IOBSL)
    YDGOMS(INUM)%TL = PSLT (IOBSL,NFLEVG)
    YDGOMS(INUM)%QL = PSLGFL(IOBSL,NFLEVG,MGOMGFL(YGOMV%MQ))
    YDGOMS(INUM)%SST = PSLSST(IOBSL)
    IF (LDMVO5) THEN
      YDGOMS(INUM)%LUPD=LLUPD
    ENDIF
  ELSE
    YDGOMS_2D(INUM)%UL(IPROF) = PSLU (IOBSL,NFLEVG)
    YDGOMS_2D(INUM)%VL(IPROF) = PSLV (IOBSL,NFLEVG)
    YDGOMS_2D(INUM)%SP(IPROF) = PSLSP(IOBSL)
    YDGOMS_2D(INUM)%TS(IPROF) = PSLTS(IOBSL)
    YDGOMS_2D(INUM)%WS(IPROF) = PSLWS(IOBSL)
    YDGOMS_2D(INUM)%SN(IPROF) = PSLSN(IOBSL)
    YDGOMS_2D(INUM)%Z0(IPROF) = PSLZ0(IOBSL)
    YDGOMS_2D(INUM)%U10N(IPROF)=PSLU10N(IOBSL)
    YDGOMS_2D(INUM)%V10N(IPROF)=PSLV10N(IOBSL)
    YDGOMS_2D(INUM)%WL(IPROF) = PSLWL(IOBSL)
    YDGOMS_2D(INUM)%TL(IPROF) = PSLT (IOBSL,NFLEVG)
    YDGOMS_2D(INUM)%QL(IPROF) = PSLGFL(IOBSL,NFLEVG,MGOMGFL(YGOMV%MQ))
    YDGOMS_2D(INUM)%SST(IPROF) = PSLSST(IOBSL)
  ENDIF
ENDDO
!$OMP END PARALLEL DO

IF (LDMVO5.OR..NOT.LOBSTL) THEN
!OCL NOVREC
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JOBS,IOBSL,IOBS,IPROF,INUM)
  DO JOBS = 1,NOBSSEND(MYPROC,ITS)
    IOBSL = IOFFS+JOBS
    IOBS = NLOCRECV(IOFFR+JOBS)
    IPROF = NLOCPROF(IOFFR+JOBS)
    INUM = KOBNUM(IOBS)

    IF(IPROF == 0) THEN
      YGOMEC(INUM)%ECOROG = PSLOROG(IOBSL)
      YGOMEC(INUM)%ECCORI = PSLCORI(IOBSL)
      YGOMEC(INUM)%ECALBE = PSLALBE(IOBSL)
      YGOMEC(INUM)%ECEMIS = PSLEMIS(IOBSL)
      YGOMEC(INUM)%ECLSMA = PSLLSMA(IOBSL)
      IF (LECMWF) THEN
        YGOMEC(INUM)%ECCI = PSLCI(IOBSL)
        YGOMEC(INUM)%ECCVH  = PSLCVH (IOBSL)
        YGOMEC(INUM)%ECCVL  = PSLCVL (IOBSL)
        YGOMEC(INUM)%ECTVH  = PSLTVH (IOBSL)
        YGOMEC(INUM)%ECTVL  = PSLTVL (IOBSL)
      ELSE
        YGOMEC(INUM)%ECVEGE = PSLVEGE(IOBSL)
      ENDIF
      YGOMEC(INUM)%ECDL = PSLDL(IOBSL)
      YGOMEC(INUM)%ECDM = PSLDM(IOBSL)
      IF (.NOT.LCANARI.AND.LSOLV.AND.(LDMVO5.OR..NOT.LOBSTL).AND.NSTEP == 0) THEN
        YGOMEC(INUM)%ECARG = 0.0_JPRB
        YGOMEC(INUM)%ECSAB = 0.0_JPRB
        YGOMEC(INUM)%ECHV  = 0.0_JPRB
        YGOMEC(INUM)%ECZ0H = 0.0_JPRB
      ENDIF
      IF (LSOLV.AND.(LDMVO5.OR..NOT.LOBSTL)) THEN
        YGOMEC(INUM)%ECARG = PSLARG (IOBSL)
        YGOMEC(INUM)%ECSAB = PSLSAB (IOBSL)
        YGOMEC(INUM)%ECHV  = PSLHV  (IOBSL)
        YGOMEC(INUM)%ECZ0H = PSLZ0H (IOBSL)
      ENDIF
    ELSE
      YGOMEC_2D(INUM)%ECOROG(IPROF) = PSLOROG(IOBSL)
      YGOMEC_2D(INUM)%ECCORI(IPROF) = PSLCORI(IOBSL)
      YGOMEC_2D(INUM)%ECALBE(IPROF) = PSLALBE(IOBSL)
      YGOMEC_2D(INUM)%ECEMIS(IPROF) = PSLEMIS(IOBSL)
      YGOMEC_2D(INUM)%ECLSMA(IPROF) = PSLLSMA(IOBSL)
      IF (LECMWF) THEN
        YGOMEC_2D(INUM)%ECCI(IPROF) = PSLCI(IOBSL)
        YGOMEC_2D(INUM)%ECCVH(IPROF)  = PSLCVH (IOBSL)
        YGOMEC_2D(INUM)%ECCVL(IPROF)  = PSLCVL (IOBSL)
        YGOMEC_2D(INUM)%ECTVH(IPROF)  = PSLTVH (IOBSL)
        YGOMEC_2D(INUM)%ECTVL(IPROF)  = PSLTVL (IOBSL)
      ELSE
        YGOMEC_2D(INUM)%ECVEGE(IPROF) = PSLVEGE(IOBSL)
      ENDIF
      YGOMEC_2D(INUM)%ECDL(IPROF) = PSLDL(IOBSL)
      YGOMEC_2D(INUM)%ECDM(IPROF) = PSLDM(IOBSL)
      IF (.NOT.LCANARI.AND.LSOLV.AND.(LDMVO5.OR..NOT.LOBSTL).AND.NSTEP == 0) THEN
        YGOMEC_2D(INUM)%ECARG(IPROF) = 0.0_JPRB
        YGOMEC_2D(INUM)%ECSAB(IPROF) = 0.0_JPRB
        YGOMEC_2D(INUM)%ECHV(IPROF)  = 0.0_JPRB
        YGOMEC_2D(INUM)%ECZ0H(IPROF) = 0.0_JPRB
      ENDIF
      IF (LSOLV.AND.(LDMVO5.OR..NOT.LOBSTL)) THEN
        YGOMEC_2D(INUM)%ECARG(IPROF) = PSLARG (IOBSL)
        YGOMEC_2D(INUM)%ECSAB(IPROF) = PSLSAB (IOBSL)
        YGOMEC_2D(INUM)%ECHV(IPROF)  = PSLHV  (IOBSL)
        YGOMEC_2D(INUM)%ECZ0H(IPROF) = PSLZ0H (IOBSL)
      ENDIF
    ENDIF
  ENDDO
!$OMP END PARALLEL DO
ENDIF

IF(LCANARI) THEN
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JOBS,IOBSL,IOBS,INUM,JLEV)
  DO JOBS = 1,NOBSSEND(MYPROC,ITS)
    IOBSL = IOFFS+JOBS
    IOBS = NLOCRECV(IOFFR+JOBS)
    INUM = KOBNUM(IOBS)
    IF (LCASIG) THEN
!      Model errors for Canari
      DO JLEV = 1,NFLEVG
        YGOMCANA(INUM)%EMMZ(JLEV) = PSLEZ(IOBSL,JLEV)
        YGOMCANA(INUM)%EMMH(JLEV) = PSLEH(IOBSL,JLEV)
      ENDDO
!      Model errors for SST, snow, T2m, Hu2m and V10m
      YGOMCAN(INUM)%EMMST = PSLEST(IOBSL)
      YGOMCAN(INUM)%EMMSN = PSLESN(IOBSL)
      YGOMCAN(INUM)%EMMT2 = PSLET2(IOBSL)
      YGOMCAN(INUM)%EMMH2 = PSLEH2(IOBSL)
      YGOMCAN(INUM)%EMMV1 = PSLEV1(IOBSL)
    ENDIF
!      Precipitations and surface climatology for Canari
    YGOMCAN(INUM)%ECPRWA  = PSLPRWA(IOBSL)
    YGOMCAN(INUM)%ECPRSN  = PSLPRSN(IOBSL)
    YGOMCAN(INUM)%ECCLITS = PSLXTS(IOBSL)
    YGOMCAN(INUM)%ECCLISN = PSLXSN(IOBSL)
  ENDDO
!$OMP END PARALLEL DO
ENDIF
CALL GSTATS(1073,1)
!    ------------------------------------------------------------------


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

!    -------------------------------------------------------------------
CONTAINS
SUBROUTINE PACK_SEND(KBP,KSEND,PBUFS)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KBP
INTEGER(KIND=JPIM),INTENT(IN)    :: KSEND
REAL(KIND=JPRB),INTENT(OUT)      :: PBUFS(:)
INTEGER(KIND=JPIM) :: IOFF,IOFFTS,IOBS,ITYP,JOBS,JLEV,JGFL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('MPOBSEQ_PACK:PACK_SEND',0,ZHOOK_HANDLE)
IOFF = NSTASEND(KSEND,ITS)                   ! Offset within send ar.
IOFFTS = NSTASEND(KSEND,ITS)-NSTASEND(1,ITS) ! Offset within timeslot
DO JOBS = 1,NOBSSEND(KSEND,ITS)
  IOBS = IOFFTS+JOBS
  ITYP = MOD(NTYPSEND(IOFF+JOBS),100)
!  CALL PACK_UA(PSLU  ,LGOMUA(ITYP,YGOMV%MU),IOBS,KBP,PBUFS)
  IF(LGOMUA(ITYP,YGOMV%MU)) THEN
    PBUFS(KBP+1:KBP+NFLEVG) = PSLU(IOBS,1:NFLEVG)
    KBP = KBP+NFLEVG
  ENDIF
!  CALL PACK_UA(PSLV  ,LGOMUA(ITYP,YGOMV%MV),IOBS,KBP,PBUFS)
  IF(LGOMUA(ITYP,YGOMV%MV)) THEN
    PBUFS(KBP+1:KBP+NFLEVG) = PSLV(IOBS,1:NFLEVG)
    KBP = KBP+NFLEVG
  ENDIF
!  CALL PACK_UA(PSLT  ,LGOMUA(ITYP,YGOMV%MT),IOBS,KBP,PBUFS)
  IF(LGOMUA(ITYP,YGOMV%MT)) THEN
    PBUFS(KBP+1:KBP+NFLEVG) = PSLT(IOBS,1:NFLEVG)
    KBP = KBP+NFLEVG
  ENDIF
  DO JGFL=1,NGOMGFL
!    CALL PACK_UA(PSLGFL(:,:,JGFL) ,LGOMGFL(ITYP,JGFL),IOBS,KBP,PBUFS)
    IF(LGOMGFL(ITYP,JGFL)) THEN
      PBUFS(KBP+1:KBP+NFLEVG) = PSLGFL(IOBS,1:NFLEVG,JGFL)
      KBP = KBP+NFLEVG
    ENDIF
  ENDDO
ENDDO

DO JOBS = 1,NOBSSEND(KSEND,ITS)
  IOBS = IOFFTS+JOBS
  PBUFS(KBP+1) = PSLU (IOBS,NFLEVG)
  PBUFS(KBP+2) = PSLV (IOBS,NFLEVG)
  PBUFS(KBP+3) = PSLSP(IOBS)
  PBUFS(KBP+4) = PSLTS(IOBS)
  PBUFS(KBP+5) = PSLWS(IOBS)
  PBUFS(KBP+6) = PSLSN(IOBS)
  PBUFS(KBP+7) = PSLZ0(IOBS)
  PBUFS(KBP+8) = PSLWL(IOBS)
  PBUFS(KBP+9) = PSLT (IOBS,NFLEVG)
  PBUFS(KBP+10) = PSLGFL(IOBS,NFLEVG,MGOMGFL(YGOMV%MQ))
  PBUFS(KBP+11) = PSLSST(IOBS)
  PBUFS(KBP+12) = PSLU0(IOBS)
  PBUFS(KBP+13) = PSLV0(IOBS)
  PBUFS(KBP+14) = PSLCHN(IOBS)
  PBUFS(KBP+15) = PSLU10N(IOBS)
  PBUFS(KBP+16) = PSLV10N(IOBS)
    IF (LDIRCLSMOD) THEN
  PBUFS(KBP+17) = PSLTCLS(IOBS)
  PBUFS(KBP+18) = PSLHUCLS(IOBS)
  KBP=KBP+2
    ENDIF
  KBP=KBP+16
  IF(LDMVO5) THEN
    PBUFS(KBP+1) = ZUPD
    KBP = KBP+1
  ENDIF
  IF(LDMVO5.OR..NOT.LOBSTL) THEN
    PBUFS(KBP+1) = PSLOROG(IOBS)
    PBUFS(KBP+2) = PSLCORI(IOBS)
    PBUFS(KBP+3) = PSLALBE(IOBS)
    PBUFS(KBP+4) = PSLEMIS(IOBS)
    PBUFS(KBP+5) = PSLLSMA(IOBS)
    IF (LECMWF) THEN
      PBUFS(KBP+6) = PSLCI(IOBS)
      PBUFS(KBP+7) = PSLCVH(IOBS)
      PBUFS(KBP+8) = PSLCVL(IOBS)
      PBUFS(KBP+9) = PSLTVH(IOBS)
      PBUFS(KBP+10) = PSLTVL(IOBS)
      PBUFS(KBP+11) = PSLDL (IOBS)
      PBUFS(KBP+12) = PSLDM (IOBS)
      KBP = KBP+12
    ELSE
      PBUFS(KBP+6) = PSLVEGE(IOBS)
      PBUFS(KBP+7) = PSLDL  (IOBS)
      PBUFS(KBP+8) = PSLDM  (IOBS)
      KBP = KBP+8
    ENDIF
  ENDIF
  IF (LSOLV.AND.(LDMVO5.OR..NOT.LOBSTL)) THEN
    PBUFS(KBP+1) = PSLARG(IOBS)
    PBUFS(KBP+2) = PSLSAB(IOBS)
    PBUFS(KBP+3) = PSLHV (IOBS)
    PBUFS(KBP+4) = PSLZ0H(IOBS)
    KBP = KBP+4
  ENDIF
ENDDO

!          Copy model error if asked in Canari
IF (LCANARI) THEN
  DO JOBS = 1,NOBSSEND(KSEND,ITS)
    IOBS = IOFFTS+JOBS
    IF (LCASIG) THEN
    !          Copy model error if asked in Canari
      DO JLEV = 1,NFLEVG
        PBUFS(KBP+0*NFLEVG+JLEV) = PSLEZ(IOBS,JLEV)
        PBUFS(KBP+1*NFLEVG+JLEV) = PSLEH(IOBS,JLEV)
      ENDDO
      KBP = KBP+2*NFLEVG
    !          model errors for sst
      PBUFS(KBP+1) =  PSLEST(IOBS)
      KBP=KBP+1
    !          model errors for Snow, T2m, Hu2m, V10m
      PBUFS(KBP+1) = PSLESN(IOBS)
      PBUFS(KBP+2) = PSLET2(IOBS)             
      PBUFS(KBP+3) = PSLEH2(IOBS)             
      PBUFS(KBP+4) = PSLEV1(IOBS)             
      KBP=KBP+4
    ENDIF
!          Precipitations and surface climatology for Canari
    PBUFS(KBP+1) = PSLPRWA(IOBS)
    PBUFS(KBP+2) = PSLPRSN(IOBS)
    PBUFS(KBP+3) = PSLXTS(IOBS)
    PBUFS(KBP+4) = PSLXSN(IOBS)
    KBP = KBP+4
  ENDDO
ENDIF
IF (KBP > IBUFLENS) THEN
  WRITE(NULERR,*) ' MPOBSEQ_PACK:',MYPROC,KSEND,KBP,IBUFLENS
  CALL ABOR1(' MPOBSEQ_PACK: SEND BUFFER TOO SMALL')
ENDIF
IF (LHOOK) CALL DR_HOOK('MPOBSEQ_PACK:PACK_SEND',1,ZHOOK_HANDLE)

END SUBROUTINE PACK_SEND
!=========================================================================

END SUBROUTINE MPOBSEQ_PACK
