source: LMDZ.3.3/trunk/libf/dyn3d/divergf.F @ 346

Last change on this file since 346 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.3 KB
Line 
1      SUBROUTINE divergf(klevel,x,y,div)
2c
3c     P. Le Van
4c
5c  *********************************************************************
6c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
7c     x et y...
8c              x et y  etant des composantes covariantes   ...
9c  *********************************************************************
10      IMPLICIT NONE
11c
12c      x  et  y  sont des arguments  d'entree pour le s-prog
13c        div      est  un argument  de sortie pour le s-prog
14c
15c
16c   ---------------------------------------------------------------------
17c
18c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
19c
20c   ---------------------------------------------------------------------
21#include "dimensions.h"
22#include "paramet.h"
23#include "comgeom.h"
24c
25c    ..........          variables en arguments    ...................
26c
27      INTEGER klevel
28      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
29      INTEGER   l,ij
30c
31c    ...............     variables  locales   .........................
32
33      REAL aiy1( iip1 ) , aiy2( iip1 )
34      REAL sumypn,sumyps
35c    ...................................................................
36c
37      EXTERNAL  SSUM
38      REAL      SSUM
39c
40c
41      DO 10 l = 1,klevel
42c
43        DO  ij = iip2, ip1jm - 1
44         div( ij + 1, l )     = 
45     *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
46     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)
47        ENDDO
48c
49c     ....  correction pour  div( 1,j,l)  ......
50c     ....   div(1,j,l)= div(iip1,j,l) ....
51c
52CDIR$ IVDEP
53        DO  ij = iip2,ip1jm,iip1
54         div( ij,l ) = div( ij + iim,l )
55        ENDDO
56c
57c     ....  calcul  aux poles  .....
58c
59        DO  ij  = 1,iim
60         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
61         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
62        ENDDO
63        sumypn = SSUM ( iim,aiy1,1 ) / apoln
64        sumyps = SSUM ( iim,aiy2,1 ) / apols
65c
66        DO  ij = 1,iip1
67         div(     ij    , l ) = - sumypn
68         div( ij + ip1jm, l ) =   sumyps
69        ENDDO
70  10  CONTINUE
71c
72
73        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
74     
75c
76        DO l = 1, klevel
77           DO ij = iip2,ip1jm
78            div(ij,l) = div(ij,l) * unsaire(ij)
79          ENDDO
80        ENDDO
81c
82       RETURN
83       END
Note: See TracBrowser for help on using the repository browser.