source: LMDZ5/trunk/libf/dyn3dmem/caldyn_loc.F @ 1838

!
! $Header$
!
c
c
#undef DEBUG_IO
!#define DEBUG_IO

      SUBROUTINE caldyn_loc
     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
      USE parallel_lmdz
      USE Write_Field_loc
      USE caldyn_mod
      
      IMPLICIT NONE

c=======================================================================
c
c  Auteur :  P. Le Van
c
c   Objet:
c   ------
c
c   Calcul des tendances dynamiques.
c
c Modif 04/93 F.Forget
c=======================================================================

c-----------------------------------------------------------------------
c   0. Declarations:
c   ----------------

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

c   Arguments:
c   ----------

      LOGICAL conser

      INTEGER itau
      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
      REAL teta(ijb_u:ije_u,llm)
      REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
      REAL pk(iip1,jjb_u:jje_u,llm),pkf(ijb_u:ije_u,llm)
      REAL phi(ijb_u:ije_u,llm),masse(ijb_u:ije_u,llm)
      REAL dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm)
      REAL dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u)
      REAL w(ijb_u:ije_u,llm)
      REAL pbaru(ijb_u:ije_u,llm),pbarv(ijb_v:ije_v,llm)
      REAL time

c   Local:
c   ------

      INTEGER   ij,l,ijb,ije,ierr


c-----------------------------------------------------------------------
c   Calcul des tendances dynamiques:
c   --------------------------------
      CALL covcont_loc  ( llm    , ucov    , vcov , ucont, vcont     )
      CALL pression_loc ( ip1jmp1, ap      , bp   ,  ps  , p         )
cym      CALL psextbar (   ps   , psexbarxy                          )
c$OMP BARRIER
      CALL massdair_loc (    p   , masse                             )
      CALL massbar_loc  (   masse, massebx , masseby                 )
      call massbarxy_loc(   masse, massebxy                          )
      CALL flumass_loc  ( massebx, masseby,vcont,ucont,pbaru,pbarv   )
      CALL dteta1_loc   (   teta , pbaru   , pbarv, dteta            )
      CALL convmas1_loc  (   pbaru, pbarv   , convm                  )
c$OMP BARRIER      
      CALL convmas2_loc  (   convm                      )
c$OMP BARRIER
#ifdef DEBUG_IO
      call WriteField_u('ucont',ucont)
      call WriteField_v('vcont',vcont)
      call WriteField_u('p',p)
      call WriteField_u('masse',masse)
      call WriteField_u('massebx',massebx)
      call WriteField_v('masseby',masseby)
      call WriteField_v('massebxy',massebxy)
      call WriteField_u('pbaru',pbaru)
      call WriteField_v('pbarv',pbarv)
      call WriteField_u('dteta',dteta)
      call WriteField_u('convm',convm)
#endif      

c$OMP BARRIER
c$OMP MASTER
      ijb=ij_begin
      ije=ij_end
            
      DO ij =ijb, ije
         dp( ij ) = convm( ij,1 ) / airesurg( ij )
      ENDDO
c$OMP END MASTER
c$OMP BARRIER
      CALL vitvert_loc ( convm  , w                                )
      CALL tourpot_loc ( vcov   , ucov  , massebxy  , vorpot       )
      CALL dudv1_loc   ( vorpot , pbaru , pbarv     , du     , dv  )

#ifdef DEBUG_IO      
      call WriteField_u('w',w)
      call WriteField_v('vorpot',vorpot)
      call WriteField_u('du',du)
      call WriteField_v('dv',dv)
#endif      
      CALL enercin_loc ( vcov   , ucov  , vcont   , ucont  , ecin  )
      CALL bernoui_loc ( ip1jmp1, llm   , phi       , ecin   , bern)
      CALL dudv2_loc   ( teta   , pkf   , bern      , du     , dv  )

#ifdef DEBUG_IO
      call WriteField_u('ecin',ecin)
      call WriteField_u('bern',bern)
      call WriteField_u('du',du)
      call WriteField_v('dv',dv)
      call WriteField_u('pkf',pkf)
#endif
      
      ijb=ij_begin-iip1
      ije=ij_end+iip1
      
      if (pole_nord) ijb=ij_begin
      if (pole_sud) ije=ij_end

c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
      DO l=1,llm
         DO ij=ijb,ije
            ang(ij,l) = ucov(ij,l) + constang(ij)
        ENDDO
      ENDDO
c$OMP END DO

      CALL advect_new_loc(ang,vcov,teta,w,massebx,masseby,du,dv,dteta) 

C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi 
C          probablement. Observe sur le code compile avec pgf90 3.0-1 
      ijb=ij_begin
      ije=ij_end
      if (pole_sud) ije=ij_end-iip1

c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
      DO l = 1, llm
         DO ij = ijb, ije, iip1
           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',  
c    ,   ' dans caldyn'
c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
          dv(ij+iim,l) = dv(ij,l)
          endif
         enddo
      enddo
c$OMP END DO NOWAIT      


      RETURN
      END