1 | ! |
---|
2 | ! $Header$ |
---|
3 | ! |
---|
4 | SUBROUTINE divergst(klevel,x,y,div) |
---|
5 | USE comgeom_mod_h |
---|
6 | USE dimensions_mod, ONLY: iim, jjm, llm, ndm |
---|
7 | USE paramet_mod_h |
---|
8 | |
---|
9 | IMPLICIT NONE |
---|
10 | ! |
---|
11 | ! P. Le Van |
---|
12 | ! |
---|
13 | ! ****************************************************************** |
---|
14 | ! ... calcule la divergence a tous les niveaux d'1 vecteur de compos. x et y... |
---|
15 | ! x et y etant des composantes contravariantes ... |
---|
16 | ! **************************************************************** |
---|
17 | ! x et y sont des arguments d'entree pour le s-prog |
---|
18 | ! div est un argument de sortie pour le s-prog |
---|
19 | ! |
---|
20 | ! |
---|
21 | ! ------------------------------------------------------------------- |
---|
22 | ! |
---|
23 | |
---|
24 | INTEGER :: klevel |
---|
25 | REAL :: x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel ) |
---|
26 | INTEGER :: ij,l,i |
---|
27 | REAL :: aiy1( iip1 ) , aiy2( iip1 ) |
---|
28 | REAL :: sumypn,sumyps |
---|
29 | |
---|
30 | REAL :: SSUM |
---|
31 | ! |
---|
32 | ! |
---|
33 | DO l = 1,klevel |
---|
34 | ! |
---|
35 | DO ij = iip2, ip1jm - 1 |
---|
36 | div( ij + 1, l ) = x(ij+1,l) - x(ij,l)+ y(ij-iim,l)-y(ij+1,l) |
---|
37 | END DO |
---|
38 | ! |
---|
39 | ! .... correction pour div( 1,j,l) ...... |
---|
40 | ! .... div(1,j,l)= div(iip1,j,l) .... |
---|
41 | ! |
---|
42 | !DIR$ IVDEP |
---|
43 | DO ij = iip2,ip1jm,iip1 |
---|
44 | div( ij,l ) = div( ij + iim,l ) |
---|
45 | END DO |
---|
46 | ! |
---|
47 | ! .... calcul aux poles ..... |
---|
48 | ! |
---|
49 | ! |
---|
50 | DO i = 1,iim |
---|
51 | aiy1(i)= y(i,l) |
---|
52 | aiy2(i)= y(i+ip1jmi1,l) |
---|
53 | END DO |
---|
54 | sumypn = SSUM ( iim,aiy1,1 ) |
---|
55 | sumyps = SSUM ( iim,aiy2,1 ) |
---|
56 | DO i = 1,iip1 |
---|
57 | div( i , l ) = - sumypn/iim |
---|
58 | div( i + ip1jm, l ) = sumyps/iim |
---|
59 | END DO |
---|
60 | ! |
---|
61 | END DO |
---|
62 | RETURN |
---|
63 | END SUBROUTINE divergst |
---|