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