SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
                         iflag1, nk1, icb1, icbs1, &
                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
                         wghti1, pbase1, buoybase1, &
                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
                         u1, v1, gz1, th1, th1_wake, &
                         tra1, &
                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
                         sig1, w01, ptop21, &
                         Ale1, Alp1, omega1, &
                         iflag, nk, icb, icbs, &
                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
                         wghti, pbase, buoybase, &
                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
                         u, v, gz, th, th_wake, &
                         tra, &
                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
                         sig, w0, ptop2, &
                         Ale, Alp, omega &
#ifdef ISO
     &    ,xtnk1,xt1,xt1_wake,xtclw1 &
     &    ,xtnk,xt,xt_wake,xtclw &
#endif
     &    )
  ! **************************************************************
  ! *
  ! CV3A_COMPRESS                                               *
  ! *
  ! *
  ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
  ! modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.28.09    *
  ! **************************************************************
#ifdef ISO
    use infotrac_phy, ONLY: ntraciso=>ntiso
    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
#ifdef ISOVERIF
    use isotopes_verif_mod
#endif
#endif

USE cv3param_mod_h
    IMPLICIT NONE


  ! inputs:
  INTEGER, INTENT (IN)                               :: len, nloc, nd, ntra
!jyg<
  LOGICAL, INTENT (IN)                               :: compress  ! compression is performed if compress is true
!>jyg
  INTEGER, DIMENSION (len), INTENT (IN)              :: iflag1, nk1, icb1, icbs1
  REAL, DIMENSION (len), INTENT (IN)                 :: plcl1, tnk1, qnk1, gznk1
  REAL, DIMENSION (len), INTENT (IN)                 :: hnk1, unk1, vnk1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: wghti1(len, nd)
  REAL, DIMENSION (len), INTENT (IN)                 :: pbase1, buoybase1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1, q1, qs1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake, q1_wake, qs1_wake
  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1, v1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: gz1, th1, th1_wake
  REAL, DIMENSION (len, nd,ntra), INTENT (IN)        :: tra1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: h1, lv1, lf1, cpn1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph1(len, nd+1)
  REAL, DIMENSION (len, nd), INTENT (IN)             :: tv1, tp1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: tvp1, clw1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: h1_wake, lv1_wake, cpn1_wake
  REAL, DIMENSION (len, nd), INTENT (IN)             :: tv1_wake, lf1_wake
  REAL, DIMENSION (len, nd), INTENT (IN)             :: sig1, w01
  REAL, DIMENSION (len), INTENT (IN)                 :: ptop21
  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1, Alp1
  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
#ifdef ISO
  REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xtclw1
  REAL, DIMENSION (ntraciso,len), INTENT (IN)        :: xtnk1
  REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xt1
  REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xt1_wake
#endif
!
  ! in/out 
  INTEGER, INTENT (INOUT)                            :: ncum
!
  ! outputs:
  ! en fait, on a nloc=len pour l'instant (cf cv_driver)
  INTEGER, DIMENSION (nloc), INTENT (OUT)            ::  iflag, nk, icb, icbs
  REAL, DIMENSION (nloc), INTENT (OUT)               ::  plcl, tnk, qnk, gznk
  REAL, DIMENSION (nloc), INTENT (OUT)               ::  hnk, unk, vnk
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  wghti
  REAL, DIMENSION (nloc), INTENT (OUT)               ::  pbase, buoybase
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  t, q, qs
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  t_wake, q_wake, qs_wake
  REAL, DIMENSION (nloc), INTENT (OUT)               ::  s_wake
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  u, v
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  gz, th, th_wake
  REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT)      ::  tra
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  h, lv, lf, cpn
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  p
  REAL, DIMENSION (nloc, nd+1), INTENT (OUT)         ::  ph
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tv, tp
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tvp, clw
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  h_wake, lv_wake, cpn_wake
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tv_wake, lf_wake
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  sig, w0
  REAL, DIMENSION (nloc), INTENT (OUT)               ::  ptop2
  REAL, DIMENSION (nloc), INTENT (OUT)               ::  Ale, Alp
  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  omega
#ifdef ISO    
  REAL, DIMENSION (ntraciso,nloc), INTENT (OUT)      ::  xtnk
  REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT)  ::  xtclw
  REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT)  ::  xt
  REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT)  ::  xt_wake
#endif

  ! local variables:
  INTEGER i, k, nn, j
#ifdef ISO  
      integer ixt  
#endif

  CHARACTER (LEN=20) :: modname = 'cv3a_compress'
  CHARACTER (LEN=80) :: abort_message

#ifdef ISOVERIF
        write(*,*) 'compress=',   compress
        write(*,*) 'nl=',nl
#endif
!jyg<
  IF (compress) THEN
!>jyg

  DO k = 1, nl + 1
    nn = 0
    DO i = 1, len
      IF (iflag1(i)==0) THEN
        nn = nn + 1
        wghti(nn, k) = wghti1(i, k)
        t(nn, k) = t1(i, k)
        q(nn, k) = q1(i, k)
        qs(nn, k) = qs1(i, k)
        t_wake(nn, k) = t1_wake(i, k)
        q_wake(nn, k) = q1_wake(i, k)
        qs_wake(nn, k) = qs1_wake(i, k)
        u(nn, k) = u1(i, k)
        v(nn, k) = v1(i, k)
        gz(nn, k) = gz1(i, k)
        th(nn, k) = th1(i, k)
        th_wake(nn, k) = th1_wake(i, k)
        h(nn, k) = h1(i, k)
        lv(nn, k) = lv1(i, k)
        lf(nn, k) = lf1(i, k)
        cpn(nn, k) = cpn1(i, k)
        p(nn, k) = p1(i, k)
        ph(nn, k) = ph1(i, k)
        tv(nn, k) = tv1(i, k)
        tp(nn, k) = tp1(i, k)
        tvp(nn, k) = tvp1(i, k)
        clw(nn, k) = clw1(i, k)
        h_wake(nn, k) = h1_wake(i, k)
        lv_wake(nn, k) = lv1_wake(i, k)
        lf_wake(nn, k) = lf1_wake(i, k)
        cpn_wake(nn, k) = cpn1_wake(i, k)
        tv_wake(nn, k) = tv1_wake(i, k)
        sig(nn, k) = sig1(i, k)
        w0(nn, k) = w01(i, k)
        omega(nn, k) = omega1(i, k)
#ifdef ISO
        do ixt=1,ntraciso
          xt(ixt,nn,k)=xt1(ixt,i,k)
          xt_wake(ixt,nn,k)=xt1_wake(ixt,i,k)
          xtclw(ixt,nn,k)=xtclw1(ixt,i,k)
        enddo
#endif
      END IF
    END DO
  END DO
!
  ! AC!      do 121 j=1,ntra
  ! AC!ccccc      do 111 k=1,nl+1
  ! AC!      do 111 k=1,nd
  ! AC!       nn=0
  ! AC!      do 101 i=1,len
  ! AC!      if(iflag1(i).eq.0)then
  ! AC!       nn=nn+1
  ! AC!       tra(nn,k,j)=tra1(i,k,j)
  ! AC!      endif
  ! AC! 101  continue
  ! AC! 111  continue
  ! AC! 121  continue

  IF (nn/=ncum) THEN
    PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
    abort_message = ''
    CALL abort_physic(modname, abort_message, 1)
  END IF

  nn = 0
  DO i = 1, len
    IF (iflag1(i)==0) THEN
      nn = nn + 1
      s_wake(nn) = s1_wake(i)
      iflag(nn) = iflag1(i)
      nk(nn) = nk1(i)
      icb(nn) = icb1(i)
      icbs(nn) = icbs1(i)
      plcl(nn) = plcl1(i)
      tnk(nn) = tnk1(i)
      qnk(nn) = qnk1(i)
      gznk(nn) = gznk1(i)
      hnk(nn) = hnk1(i)
      unk(nn) = unk1(i)
      vnk(nn) = vnk1(i)
      pbase(nn) = pbase1(i)
      buoybase(nn) = buoybase1(i)
      sig(nn, nd) = sig1(i, nd)
      ptop2(nn) = ptop2(i)
      Ale(nn) = Ale1(i)
      Alp(nn) = Alp1(i)
#ifdef ISO
        do ixt=1,ntraciso
          xtnk(ixt,nn)=xtnk1(ixt,i)
        enddo
#endif
    END IF
  END DO

  IF (nn/=ncum) THEN
    PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
    abort_message = ''
    CALL abort_physic(modname, abort_message, 1)
  END IF
!
!jyg<
  ELSE  !(compress)
!
      ncum = len
!
      wghti(:,1:nl+1) = wghti1(:,1:nl+1)
      t(:,1:nl+1) = t1(:,1:nl+1)
      q(:,1:nl+1) = q1(:,1:nl+1)
      qs(:,1:nl+1) = qs1(:,1:nl+1)
      t_wake(:,1:nl+1) = t1_wake(:,1:nl+1)
      q_wake(:,1:nl+1) = q1_wake(:,1:nl+1)
      qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1)
      u(:,1:nl+1) = u1(:,1:nl+1)
      v(:,1:nl+1) = v1(:,1:nl+1)
      gz(:,1:nl+1) = gz1(:,1:nl+1)
      th(:,1:nl+1) = th1(:,1:nl+1)
      th_wake(:,1:nl+1) = th1_wake(:,1:nl+1)
      h(:,1:nl+1) = h1(:,1:nl+1)
      lv(:,1:nl+1) = lv1(:,1:nl+1)
      lf(:,1:nl+1) = lf1(:,1:nl+1)
      cpn(:,1:nl+1) = cpn1(:,1:nl+1)
      p(:,1:nl+1) = p1(:,1:nl+1)
      ph(:,1:nl+1) = ph1(:,1:nl+1)
      tv(:,1:nl+1) = tv1(:,1:nl+1)
      tp(:,1:nl+1) = tp1(:,1:nl+1)
      tvp(:,1:nl+1) = tvp1(:,1:nl+1)
      clw(:,1:nl+1) = clw1(:,1:nl+1)
      h_wake(:,1:nl+1) = h1_wake(:,1:nl+1)
      lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1)
      lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1)
      cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1)
      tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1)
      sig(:,1:nl+1) = sig1(:,1:nl+1)
      w0(:,1:nl+1) = w01(:,1:nl+1)
      omega(:,1:nl+1) = omega1(:,1:nl+1)
#ifdef ISO
      xt(:,:,1:nl+1) = xt1(:,:,1:nl+1)
      xtclw(:,:,1:nl+1) = xtclw1(:,:,1:nl+1)
      xt_wake(:,:,1:nl+1) = xt1_wake(:,:,1:nl+1)
#endif
!
      s_wake(:) = s1_wake(:)
      iflag(:) = iflag1(:)
      nk(:) = nk1(:)
      icb(:) = icb1(:)
      icbs(:) = icbs1(:)
      plcl(:) = plcl1(:)
      tnk(:) = tnk1(:)
      qnk(:) = qnk1(:)
      gznk(:) = gznk1(:)
      hnk(:) = hnk1(:)
      unk(:) = unk1(:)
      vnk(:) = vnk1(:)
      pbase(:) = pbase1(:)
      buoybase(:) = buoybase1(:)
      sig(:, nd) = sig1(:, nd)
      ptop2(:) = ptop2(:)
      Ale(:) = Ale1(:)
      Alp(:) = Alp1(:)
#ifdef ISO
      xtnk(:,:) = xtnk1(:,:)
#endif
!
  ENDIF !(compress)
!>jyg

  RETURN
END SUBROUTINE cv3a_compress
