fluxstokenc_p.f90 Source File

!
! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
!
!
!
      SUBROUTINE fluxstokenc_p(pbaru,pbarv , &
              masse,  teta, phi)
  USE tracstoke_mod_h
  USE parallel_lmdz
  USE control_mod, ONLY : iapp_tracvl,planet_type,iphysiq
  USE caladvtrac_mod
  USE mod_hallo
  USE bands
  USE times
  USE Vampir
  USE write_field_loc

  !
  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h
IMPLICIT NONE
  !
  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
  !
  !=======================================================================
  !
  !   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 :: 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.EQ.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.EQ.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.EQ.(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