!
! $Id: traceurpole.f90 5272 2024-10-24 15:53:15Z abarral $
!
    subroutine traceurpole(q,masse)

      USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
implicit none



  include "comdissip.h"
  include "comgeom2.h"
  include "description.h"


  !   Arguments
   integer :: iq
   real :: masse(iip1,jjp1,llm)
   real :: q(iip1,jjp1,llm)


  !   Locals
  integer :: i,j,l
  real :: sommemassen(llm)
  real :: sommemqn(llm)
  real :: sommemasses(llm)
  real :: sommemqs(llm)
  real :: qpolen(llm),qpoles(llm)


  ! On impose une seule valeur au p�le Sud j=jjm+1=jjp1
  sommemasses=0
  sommemqs=0
      do l=1,llm
         do i=1,iip1
             sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
             sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
         enddo
      qpoles(l)=sommemqs(l)/sommemasses(l)
      enddo

  ! On impose une seule valeur du traceur au p�le Nord j=1
  sommemassen=0
  sommemqn=0
     do l=1,llm
       do i=1,iip1
           sommemassen(l)=sommemassen(l)+masse(i,1,l)
           sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
       enddo
       qpolen(l)=sommemqn(l)/sommemassen(l)
     enddo

  ! On force le traceur � prendre cette valeur aux p�les
    do l=1,llm
        do i=1,iip1
           q(i,1,l)=qpolen(l)
           q(i,jjp1,l)=qpoles(l)
         enddo
    enddo


  return
end subroutine traceurpole