source: LMDZ6/trunk/libf/dyn3d_common/gradiv2.F @ 5069

Last change on this file since 5069 was 4593, checked in by yann meurdesoif, 17 months ago

Replace #include (c preprocessor) by INCLUDE (fortran keyword)

in phylmd (except rrtm and ecrad) filtrez, dy3dmem and dyn3dcommon

Other directories will follow
YM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.9 KB
RevLine 
[524]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
[4593]20      INCLUDE "dimensions.h"
21      INCLUDE "paramet.h"
22      INCLUDE "comgeom.h"
23      INCLUDE "comdissipn.h"
[524]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.