source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90 @ 5133

! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $

!
!
SUBROUTINE fluxstokenc_p(pbaru, pbarv, masse, teta, phi)
  USE parallel_lmdz
  USE control_mod, ONLY: iapp_tracvl, planet_type, iphysiq
  USE caladvtrac_mod
  USE mod_hallo
  USE bands
  USE times
  USE lmdz_vampir
  USE write_field_loc


  IMPLICIT NONE
  !
  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
  !
  !=======================================================================
  !
  !   Shema de  Van Leer
  !
  !=======================================================================

  include "dimensions.h"
  include "paramet.h"
  include "tracstoke.h"

  !   Arguments:
  !   ----------
  REAL :: pbaru(ijb_u:ije_u, llm), pbarv(ijb_v:ije_v, llm)
  REAL :: masse(ijb_u:ije_u, llm)
  REAL :: teta(ijb_u:ije_u, llm)
  REAL :: phi(ijb_u:ije_u, llm)

  INTEGER, SAVE :: pasflx = 0
  !$OMP THREADPRIVATE(pasflx)
  INTEGER :: ijb, ije, ijbu, ijbv, ijeu, ijev, j
  INTEGER :: ij, l
  TYPE(Request), SAVE :: Request_vanleer
  !$OMP THREADPRIVATE(Request_vanleer)



  !WRITE(*,*) 'caladvtrac 58: entree'
  ijbu = ij_begin
  ijeu = ij_end

  ijbv = ij_begin - iip1
  ijev = ij_end
  IF (pole_nord) ijbv = ij_begin
  IF (pole_sud)  ijev = ij_end - iip1

  IF(pasflx==0) THEN
    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l = 1, llm
      tetac(ijbu:ijeu, l) = 0.
      phic(ijbu:ijeu, l) = 0.
      pbarucc(ijbu:ijeu, l) = 0.
      pbarvcc(ijbv:ijev, l) = 0.
    ENDDO
    !$OMP END DO NOWAIT
  ENDIF

  !   accumulation des flux de masse horizontaux
  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l = 1, llm
    DO ij = ijbu, ijeu
      pbarucc(ij, l) = pbarucc(ij, l) + pbaru(ij, l)
      tetac(ij, l) = tetac(ij, l) + teta(ij, l)
      phic(ij, l) = phic(ij, l) + phi(ij, l)

    ENDDO
    DO ij = ijbv, ijev
      pbarvcc(ij, l) = pbarvcc(ij, l) + pbarv(ij, l)
    ENDDO
  ENDDO
  !$OMP END DO NOWAIT

  !   selection de la masse instantannee des mailles avant le transport.
  IF(pasflx==0) THEN

    ijb = ij_begin
    ije = ij_end

    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l = 1, llm
      massec(ijb:ije, l) = masse(ijb:ije, l)
    ENDDO
    !$OMP END DO NOWAIT

  ENDIF

  pasflx = pasflx + 1


  !   Test pour savoir si on advecte a ce pas de temps

  IF (pasflx==(iphysiq * istphy)) THEN
    !WRITE(*,*) 'caladvtrac 133'
    !$OMP MASTER
    CALL suspend_timer(timer_caldyn)
    !$OMP END MASTER

    ijb = ij_begin
    ije = ij_end


    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l = 1, llm
      pbarucc(ijb:ije, l) = pbarucc(ijb:ije, l) / REAL(iphysiq * istphy)
      tetac(ijb:ije, l) = tetac(ijb:ije, l) / REAL(iphysiq * istphy)
      phic(ijb:ije, l) = phic(ijb:ije, l) / REAL(iphysiq * istphy)
    ENDDO
    !$OMP ENDDO NOWAIT

    IF (pole_sud) ije = ij_end - iip1

    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l = 1, llm
      pbarvcc(ijb:ije, l) = pbarvcc(ijb:ije, l) / REAL(iphysiq * istphy)
    ENDDO
    !$OMP ENDDO NOWAIT


    !$OMP BARRIER
    CALL Register_Hallo_u(pbarucc, llm, 1, 1, 1, 1, Request_vanleer)
    CALL Register_Hallo_v(pbarvcc, llm, 1, 1, 1, 1, Request_vanleer)
    CALL SendRequest(Request_vanleer)
    !$OMP BARRIER
    CALL WaitRequest(Request_vanleer)
    !$OMP BARRIER

    !c   ..  Modif P.Le Van  ( 20/12/97 )  ....
    !c

    !   traitement des flux de masse avant advection.
    ! 1. calcul de w
    ! 2. groupement des mailles pres du pole.

    CALL groupe_loc(massec, pbarucc, pbarvcc, pbarugg, pbarvgg, wgg)

    ijb = ij_begin
    ije = ij_end

    !$OMP BARRIER
    CALL WriteField_u('pbarug', pbarugg)
    CALL WriteField_v('pbarvg', pbarvgg)
    CALL WriteField_u('wg', wgg)
    CALL WriteField_u('tetag', tetac)
    CALL WriteField_u('phig', phic)
    CALL WriteField_u('masseg', massec)


    !$OMP MASTER
    CALL Set_Distrib(distrib_caldyn)
    CALL VTe(VThallo)
    CALL resume_timer(timer_caldyn)
    !$OMP END MASTER


    !$OMP BARRIER
    pasflx = 0
  ENDIF ! if iadvtr.EQ.iapp_tracvl

END SUBROUTINE fluxstokenc_p