source: LMDZ4/branches/unlabeled-1.1.1/libf/dyn3d/gradiv2.F @ 4667

Last change on this file since 4667 was 524, checked in by lmdzadmin, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.9 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
5c
6c     P. Le Van
7c
8c   **********************************************************
9c                                ld
10c       calcul  de  (grad (div) )   du vect. v ....
11c
12c     xcov et ycov etant les composant.covariantes de v
13c   **********************************************************
14c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
15c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
16c
17c
18      IMPLICIT NONE
19c
20#include "dimensions.h"
21#include "paramet.h"
22#include "comgeom.h"
23#include "comdissipn.h"
24c
25c     ........    variables en arguments      ........
26
27      INTEGER klevel
28      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
29      REAL   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
30c
31c     ........       variables locales       .........
32c
33      REAL div(ip1jmp1,llm)
34      REAL signe, nugrads
35      INTEGER l,ij,iter,ld
36     
37c    ........................................................
38c
39c
40      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
41      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
42c
43c
44      signe   = (-1.)**ld
45      nugrads = signe * cdivu
46c
47
48
49      CALL    divergf( klevel, gdx,   gdy , div )
50
51      IF( ld.GT.1 )   THEN
52
53        CALL laplacien ( klevel, div,  div     )
54
55c    ......  Iteration de l'operateur laplacien_gam   .......
56
57        DO iter = 1, ld -2
58         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
59     *                       unsapolnga1, unsapolsga1,  div, div       )
60        ENDDO
61
62      ENDIF
63
64
65       CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
66       CALL  grad  ( klevel,  div,   gdx,  gdy             )
67
68c
69       DO   l = 1, klevel
70         DO  ij = 1, ip1jmp1
71          gdx( ij,l ) = gdx( ij,l ) * nugrads
72         ENDDO
73         DO  ij = 1, ip1jm
74          gdy( ij,l ) = gdy( ij,l ) * nugrads
75         ENDDO
76       ENDDO
77c
78       RETURN
79       END
Note: See TracBrowser for help on using the repository browser.