My Project
 All Classes Files Functions Variables Macros
diverg.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE diverg(klevel,x,y,div)
5 c
6 c P. Le Van
7 c
8 c *********************************************************************
9 c ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
10 c x et y...
11 c x et y etant des composantes covariantes ...
12 c *********************************************************************
13  IMPLICIT NONE
14 c
15 c x et y sont des arguments d'entree pour le s-prog
16 c div est un argument de sortie pour le s-prog
17 c
18 c
19 c ---------------------------------------------------------------------
20 c
21 c ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/ .
22 c
23 c ---------------------------------------------------------------------
24 #include "dimensions.h"
25 #include "paramet.h"
26 #include "comgeom.h"
27 c
28 c .......... variables en arguments ...................
29 c
30  INTEGER klevel
31  REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
32  INTEGER l,ij
33 c
34 c ............... variables locales .........................
35 
36  REAL aiy1( iip1 ) , aiy2( iip1 )
37  REAL sumypn,sumyps
38 c ...................................................................
39 c
40  REAL ssum
41 c
42 c
43  DO 10 l = 1,klevel
44 c
45  DO ij = iip2, ip1jm - 1
46  div( ij + 1, l ) =
47  * cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
48  * cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)
49  ENDDO
50 c
51 c .... correction pour div( 1,j,l) ......
52 c .... div(1,j,l)= div(iip1,j,l) ....
53 c
54 CDIR$ IVDEP
55  DO ij = iip2,ip1jm,iip1
56  div( ij,l ) = div( ij + iim,l )
57  ENDDO
58 c
59 c .... calcul aux poles .....
60 c
61  DO ij = 1,iim
62  aiy1(ij) = cuvsurcv( ij ) * y( ij , l )
63  aiy2(ij) = cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
64  ENDDO
65  sumypn = ssum( iim,aiy1,1 ) / apoln
66  sumyps = ssum( iim,aiy2,1 ) / apols
67 c
68  DO ij = 1,iip1
69  div( ij , l ) = - sumypn
70  div( ij + ip1jm, l ) = sumyps
71  ENDDO
72  10 CONTINUE
73 c
74 
75 ccc CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
76 
77 c
78  DO l = 1, klevel
79  DO ij = iip2,ip1jm
80  div(ij,l) = div(ij,l) * unsaire(ij)
81  ENDDO
82  ENDDO
83 c
84  RETURN
85  END