caladvtrac_loc.F

Go to the documentation of this file.

!
! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
!
c
c
            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
c
      IMPLICIT NONE
c
c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron  
c
c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
c=======================================================================
c
c       Shema de  Van Leer
c
c=======================================================================


#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"

c   Arguments:
c   ----------
      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
c   Local:
c   ------
!      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
c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)        
                DO l=1,llm   
          pbaruc(ijbu:ijeu,l)=0.
          pbarvc(ijbv:ijev,l)=0.
        ENDDO
c$OMP END DO NOWAIT  
      ENDIF

c   accumulation des flux de masse horizontaux
c$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
c$OMP END DO NOWAIT

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

          ijb=ij_begin
          ije=ij_end

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

      ENDIF

      iadvtr   = iadvtr+1

c$OMP MASTER
      iapptrac = iadvtr
c$OMP END MASTER

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

      IF ( iadvtr.EQ.iapp_tracvl ) THEN
      !write(*,*) 'caladvtrac 133'
c$OMP MASTER
        call suspend_timer(timer_caldyn)
c$OMP END MASTER
      
      ijb=ij_begin
      ije=ij_end
      
cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
cc

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

        CALL groupe_loc( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )

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

#ifdef DEBUG_IO    
         CALL writefield_u('pbarug1',pbarug)
         CALL writefield_v('pbarvg1',pbarvg)
         CALL writefield_u('wg1',wg)
#endif

c$OMP BARRIER


c$OMP MASTER
      call vtb(vthallo)
c$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)
c$OMP BARRIER
      call waitrequest(request_vanleer)


c$OMP BARRIER
c$OMP MASTER      
      call set_distrib(distrib_vanleer)
      call vte(vthallo)
      call vtb(vtadvection)
      call start_timer(timer_vanleer)
c$OMP END MASTER
c$OMP BARRIER
!      CALL WriteField_u('pbarug_adv',pbarug_adv)
!      CALL WriteField_u('',)
      
      
#ifdef DEBUG_IO
         CALL writefield_u('pbarug1',pbarug_adv)
         CALL writefield_v('pbarvg1',pbarvg_adv)
         CALL writefield_u('wg1',wg_adv)
#endif        
      !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'


c$OMP MASTER
                call vte(vtadvection)
        call stop_timer(timer_vanleer)
        call vtb(vthallo)
c$OMP END MASTER

        call register_swapfield_u(q_adv,q,distrib_caldyn,
     *                             request_vanleer)

        call sendrequest(request_vanleer)
c$OMP BARRIER
        call waitrequest(request_vanleer)      

c$OMP BARRIER
c$OMP MASTER
        call set_distrib(distrib_caldyn)
                call vte(vthallo)
                call resume_timer(timer_caldyn)
c$OMP END MASTER
c$OMP BARRIER   
          iadvtr=0
       ENDIF ! if iadvtr.EQ.iapp_tracvl

      END