traceurpole.f90 Source File

!
! $Id: traceurpole.f90 5285 2024-10-28 13:33:29Z abarral $
!
    subroutine traceurpole(q,masse)

      USE comgeom2_mod_h
  USE comdissip_mod_h
  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h
implicit none



  !   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