tourabs.F

Go to the documentation of this file.

      SUBROUTINE tourabs ( ntetaSTD,vcov, ucov, vorabs )
      IMPLICIT NONE

c=======================================================================
c
c   Modif:  I. Musat (28/10/04)
c   -------
c   adaptation du code tourpot.F pour le calcul de la vorticite absolue
c   cf. P. Le Van
c
c   Objet: 
c   ------
c
c    *******************************************************************
c    .............  calcul de la vorticite absolue     .................
c    *******************************************************************
c
c     ntetaSTD, vcov,ucov      sont des argum. d'entree pour le s-pg .
c             vorabs            est  un argum.de sortie pour le s-pg .
c
c=======================================================================

#include "dimensions.h"
#include "paramet.h"
#include "comgeom.h"
#include "logic.h"
#include "comconst.h"
c
      INTEGER ntetastd
      REAL vcov( ip1jm,ntetastd ), ucov( ip1jmp1,ntetastd )
      REAL vorabs( ip1jm,ntetastd )
c
c variables locales
      INTEGER l, ij, i, j
      REAL  rot( ip1jm,ntetastd )



c  ... vorabs = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) ..



c    ........  Calcul du rotationnel du vent V  puis filtrage  ........

      DO 5 l = 1,ntetastd

      DO 2 i = 1, iip1
      DO 2 j = 1, jjm
c
       ij=i+(j-1)*iip1
       IF(ij.LE.ip1jm - 1) THEN
c
        IF(cv(ij).EQ.0..OR.cv(ij+1).EQ.0..OR.
     $     cu(ij).EQ.0..OR.cu(ij+iip1).EQ.0.) THEN
         rot( ij,l ) = 0.
         continue
        ELSE
         rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/
     $                 (2.*pi*rad*cos(rlatv(j)))*REAL(iim)
     $                +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
     $                 (pi*rad)*(REAL(jjm)-1.)
c
        ENDIF
       ENDIF !(ij.LE.ip1jm - 1) THEN
   2  CONTINUE

c    ....  correction pour  rot( iip1,j,l )  .....
c    ....     rot(iip1,j,l) = rot(1,j,l)    .....

CDIR$ IVDEP

      DO 3 ij = iip1, ip1jm, iip1
      rot( ij,l ) = rot( ij -iim, l )
   3  CONTINUE

   5  CONTINUE


      CALL  filtreg( rot, jjm, ntetastd, 2, 1, .false., 1 )


      DO 10 l = 1, ntetastd

      DO 6 ij = 1, ip1jm - 1
      vorabs( ij,l ) = ( rot(ij,l) + fext(ij)*unsairez(ij) )
   6  CONTINUE

c    ..... correction pour  vorabs( iip1,j,l)  .....
c    ....   vorabs(iip1,j,l)= vorabs(1,j,l) ....
CDIR$ IVDEP
      DO 8 ij = iip1, ip1jm, iip1
      vorabs( ij,l ) = vorabs( ij -iim,l )
   8  CONTINUE

  10  CONTINUE

      RETURN
      END