source: LMDZ4/trunk/libf/dyn3d/tourabs.F @ 1364

Last change on this file since 1364 was 644, checked in by Laurent Fairhead, 19 years ago

Synchronisation avec tous les diagnostiques de Ionela IM
Inclusion du slab ocean IM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
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)))*float(iim)
60     $                +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
61     $                 (pi*RAD)*(float(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.