source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90 @ 5106

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

!
!
SUBROUTINE caladvtrac_loc(q, pbaru, pbarv, &
        p, masse, dq, teta, &
        flxw, pk, iapptrac)
  USE parallel_lmdz
  USE infotrac, ONLY: nqtot
  USE control_mod, ONLY: iapp_tracvl, planet_type
  USE caladvtrac_mod
  USE mod_hallo
  USE bands
  USE times
  USE Vampir
  USE write_field_loc
  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO

  IMPLICIT NONE
  !
  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
  !
  ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur
  !=======================================================================
  !
  !   Shema de  Van Leer
  !
  !=======================================================================

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

  !   Arguments:
  !   ----------
  REAL :: pbaru(ijb_u:ije_u, llm), pbarv(ijb_v:ije_v, llm)
  REAL :: masse(ijb_u:ije_u, llm)
  REAL :: p(ijb_u:ije_u, llmp1)
  REAL :: q(ijb_u:ije_u, llm, nqtot), dq(ijb_u:ije_u, llm, nqtot)
  REAL :: teta(ijb_u:ije_u, llm), pk(ijb_u:ije_u, llm)
  REAL :: flxw(ijb_u:ije_u, llm)
  INTEGER :: iapptrac
  !   Local:
  !   ------
  ! REAL :: pbarug(ijb_u:ije_u,llm)
  ! REAL :: pbarvg(ijb_v:ije_v,llm)
  !      REAL :: wg(ijb_u:ije_u,llm)

  REAL :: flxw_adv(distrib_vanleer%ijb_u:distrib_vanleer%ije_u, llm)
  INTEGER, SAVE :: iadvtr = 0
  !$OMP THREADPRIVATE(iadvtr)
  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(iadvtr==0) THEN
    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l = 1, llm
      pbaruc(ijbu:ijeu, l) = 0.
      pbarvc(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
      pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)
    ENDDO
    DO ij = ijbv, ijev
      pbarvc(ij, l) = pbarvc(ij, l) + pbarv(ij, l)
    ENDDO
  ENDDO
  !$OMP END DO NOWAIT

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

    ijb = ij_begin
    ije = ij_end

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

  ENDIF

  iadvtr = iadvtr + 1

  !$OMP MASTER
  iapptrac = iadvtr
  !$OMP END MASTER

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

  IF (iadvtr==iapp_tracvl) THEN
    ! !write(*,*) 'caladvtrac 133'
    !$OMP MASTER
    CALL suspend_timer(timer_caldyn)
    !$OMP END MASTER

    ijb = ij_begin
    ije = ij_end

    !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(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)

    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l = 1, llm
      flxw(ijb:ije, l) = wg(ijb:ije, l) / REAL(iapp_tracvl)
    ENDDO
    !$OMP ENDDO NOWAIT

    IF (CPPKEY_DEBUGIO) THEN
      CALL WriteField_u('pbarug1', pbarug)
      CALL WriteField_v('pbarvg1', pbarvg)
      CALL WriteField_u('wg1', wg)
    END IF

    !$OMP BARRIER


    !$OMP MASTER
    CALL VTb(VTHallo)
    !$OMP END MASTER

    CALL Register_SwapField_u(pbarug, pbarug_adv, distrib_vanleer, &
            Request_vanleer)
    CALL Register_SwapField_v(pbarvg, pbarvg_adv, distrib_vanleer, &
            Request_vanleer, up = 1)
    CALL Register_SwapField_u(massem, massem_adv, distrib_vanleer, &
            Request_vanleer)
    CALL Register_SwapField_u(wg, wg_adv, distrib_vanleer, &
            Request_vanleer)
    CALL Register_SwapField_u(teta, teta_adv, distrib_vanleer, &
            Request_vanleer, up = 1, down = 1)
    CALL Register_SwapField_u(p, p_adv, distrib_vanleer, &
            Request_vanleer, up = 1, down = 1)
    CALL Register_SwapField_u(pk, pk_adv, distrib_vanleer, &
            Request_vanleer, up = 1, down = 1)
    CALL Register_SwapField_u(q, q_adv, distrib_vanleer, &
            Request_vanleer)

    CALL SendRequest(Request_vanleer)
    !$OMP BARRIER
    CALL WaitRequest(Request_vanleer)


    !$OMP BARRIER
    !$OMP MASTER
    CALL Set_Distrib(distrib_vanleer)
    CALL VTe(VTHallo)
    CALL VTb(VTadvection)
    CALL start_timer(timer_vanleer)
    !$OMP END MASTER
    !$OMP BARRIER
    ! CALL WriteField_u('pbarug_adv',pbarug_adv)
    ! CALL WriteField_u('',)

    IF (CPPKEY_DEBUGIO) THEN
      CALL WriteField_u('pbarug1', pbarug_adv)
      CALL WriteField_v('pbarvg1', pbarvg_adv)
      CALL WriteField_u('wg1', wg_adv)
    END IF
    ! !write(*,*) 'caladvtrac 185'
    CALL advtrac_loc(pbarug_adv, pbarvg_adv, wg_adv, &
            p_adv, massem_adv, q_adv, teta_adv, &
            pk_adv)
    ! !write(*,*) 'caladvtrac 189'


    !$OMP MASTER
    CALL VTe(VTadvection)
    CALL stop_timer(timer_vanleer)
    CALL VTb(VThallo)
    !$OMP END MASTER

    CALL Register_SwapField_u(q_adv, q, distrib_caldyn, &
            Request_vanleer)

    CALL SendRequest(Request_vanleer)
    !$OMP BARRIER
    CALL WaitRequest(Request_vanleer)

    !$OMP BARRIER
    !$OMP MASTER
    CALL Set_Distrib(distrib_caldyn)
    CALL VTe(VThallo)
    CALL resume_timer(timer_caldyn)
    !$OMP END MASTER
    !$OMP BARRIER
    iadvtr = 0
  ENDIF ! if iadvtr.EQ.iapp_tracvl

END SUBROUTINE caladvtrac_loc