source: LMDZ5/trunk/libf/tourabs.F @ 1630

Last change on this file since 1630 was 1630, checked in by Laurent Fairhead, 12 years ago

Importation initiale du répertoire dyn3dmem


Initial import of dyn3dmem directory

File size: 2.4 KB
Line 
1      SUBROUTINE tourabs ( ntetaSTD,vcov, ucov, vorabs )
2      IMPLICIT NONE
3
4c=======================================================================
5c
6c   Modif:  I. Musat (28/10/04)
7c   -------
8c   adaptation du code tourpot.F pour le calcul de la vorticite absolue
9c   cf. P. Le Van
10c
11c   Objet:
12c   ------
13c
14c    *******************************************************************
15c    .............  calcul de la vorticite absolue     .................
16c    *******************************************************************
17c
18c     ntetaSTD, vcov,ucov      sont des argum. d'entree pour le s-pg .
19c             vorabs            est  un argum.de sortie pour le s-pg .
20c
21c=======================================================================
22
23#include "dimensions.h"
24#include "paramet.h"
25#include "comgeom.h"
26#include "logic.h"
27#include "comconst.h"
28c
29      INTEGER ntetaSTD
30      REAL vcov( ip1jm,ntetaSTD ), ucov( ip1jmp1,ntetaSTD )
31      REAL vorabs( ip1jm,ntetaSTD )
32c
33c variables locales
34      INTEGER l, ij, i, j
35      REAL  rot( ip1jm,ntetaSTD )
36
37
38
39c  ... vorabs = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) ..
40
41
42
43c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
44
45      DO 5 l = 1,ntetaSTD
46
47      DO 2 i = 1, iip1
48      DO 2 j = 1, jjm
49c
50       ij=i+(j-1)*iip1
51       IF(ij.LE.ip1jm - 1) THEN
52c
53        IF(cv(ij).EQ.0..OR.cv(ij+1).EQ.0..OR.
54     $     cu(ij).EQ.0..OR.cu(ij+iip1).EQ.0.) THEN
55         rot( ij,l ) = 0.
56         continue
57        ELSE
58         rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/
59     $                 (2.*pi*RAD*cos(rlatv(j)))*REAL(iim)
60     $                +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
61     $                 (pi*RAD)*(REAL(jjm)-1.)
62c
63        ENDIF
64       ENDIF !(ij.LE.ip1jm - 1) THEN
65   2  CONTINUE
66
67c    ....  correction pour  rot( iip1,j,l )  .....
68c    ....     rot(iip1,j,l) = rot(1,j,l)    .....
69
70CDIR$ IVDEP
71
72      DO 3 ij = iip1, ip1jm, iip1
73      rot( ij,l ) = rot( ij -iim, l )
74   3  CONTINUE
75
76   5  CONTINUE
77
78
79      CALL  filtreg( rot, jjm, ntetaSTD, 2, 1, .FALSE., 1 )
80
81
82      DO 10 l = 1, ntetaSTD
83
84      DO 6 ij = 1, ip1jm - 1
85      vorabs( ij,l ) = ( rot(ij,l) + fext(ij)*unsairez(ij) )
86   6  CONTINUE
87
88c    ..... correction pour  vorabs( iip1,j,l)  .....
89c    ....   vorabs(iip1,j,l)= vorabs(1,j,l) ....
90CDIR$ IVDEP
91      DO 8 ij = iip1, ip1jm, iip1
92      vorabs( ij,l ) = vorabs( ij -iim,l )
93   8  CONTINUE
94
95  10  CONTINUE
96
97      RETURN
98      END
Note: See TracBrowser for help on using the repository browser.