source: LMDZ5/trunk/libf/dyn3dmem/tourabs.F @ 1785

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

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 2.4 KB
RevLine 
[1632]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.