source: trunk/LMDZ.GENERIC/libf/dyn3d/divergst.F @ 588

Last change on this file since 588 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 1.5 KB
RevLine 
[135]1      SUBROUTINE divergst(klevel,x,y,div)
2      IMPLICIT NONE
3c
4c     P. Le Van
5c
6c  ******************************************************************
7c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. x et y...
8c           x et y  etant des composantes contravariantes   ...
9c  ****************************************************************
10c      x  et  y  sont des arguments  d'entree pour le s-prog
11c        div      est  un argument  de sortie pour le s-prog
12c
13c
14c   -------------------------------------------------------------------
15c
16#include "dimensions.h"
17#include "paramet.h"
18#include "comgeom.h"
19
20      INTEGER klevel
21      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
22      INTEGER ij,l,i
23      REAL aiy1( iip1 ) , aiy2( iip1 )
24      REAL sumypn,sumyps
25
26      REAL SSUM
27      EXTERNAL SSUM
28c
29c
30      DO 10 l = 1,klevel
31c
32      DO 1 ij = iip2, ip1jm - 1
33      div( ij + 1, l ) = x(ij+1,l) - x(ij,l)+ y(ij-iim,l)-y(ij+1,l)
34   1  CONTINUE
35c
36c     ....  correction pour  div( 1,j,l)  ......
37c     ....   div(1,j,l)= div(iip1,j,l) ....
38c
39CDIR$ IVDEP
40      DO 3 ij = iip2,ip1jm,iip1
41      div( ij,l ) = div( ij + iim,l )
42   3  CONTINUE
43c
44c     ....  calcul  aux poles  .....
45c
46c
47      DO 5 i  = 1,iim
48      aiy1(i)= y(i,l)
49      aiy2(i)= y(i+ip1jmi1,l)
50   5  CONTINUE
51      sumypn = SSUM ( iim,aiy1,1 )
52      sumyps = SSUM ( iim,aiy2,1 )
53      DO 7 i = 1,iip1
54      div(     i    , l ) = - sumypn/iim
55      div( i + ip1jm, l ) =   sumyps/iim
56   7  CONTINUE
57c
58  10  CONTINUE
59      RETURN
60      END
Note: See TracBrowser for help on using the repository browser.