source: LMDZ6/trunk/libf/dyn3dmem/caladvtrac_loc.f90 @ 5282

!
! $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
  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
  !
  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
  !
  ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur
  !=======================================================================
  !
  !   Shema de  Van Leer
  !
  !=======================================================================





  !   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.EQ.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.EQ.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.EQ.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