source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradiv.f90 @ 5134

Last change on this file since 5134 was 5134, checked in by abarral, 4 months ago

Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules
Remove unused clesph0.h

  • 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.4 KB
Line 
1! $Header$
2
3SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy)
4  !
5  !    Auteur :   P. Le Van
6  !
7  !   ***************************************************************
8  !
9  !                            ld
10  !   calcul  de  (grad (div) )   du vect. v ....
11  !
12  ! xcov et ycov etant les composant.covariantes de v
13  !   ****************************************************************
14  !    xcov , ycov et ld  sont des arguments  d'entree pour le s-prog
15  !     gdx   et  gdy     sont des arguments de sortie pour le s-prog
16  !
17  !
18  USE lmdz_filtreg, ONLY: filtreg
19  USE lmdz_ssum_scopy, ONLY: scopy
20  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
21
22  IMPLICIT NONE
23  !
24  INCLUDE "dimensions.h"
25  INCLUDE "paramet.h"
26
27  INTEGER :: klevel
28  !
29  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
30  REAL :: gdx(ip1jmp1, klevel), gdy(ip1jm, klevel)
31
32  REAL :: div(ip1jmp1, llm)
33
34  INTEGER :: l, ij, iter, ld
35  !
36  !
37  !
38  CALL SCOPY(ip1jmp1 * klevel, xcov, 1, gdx, 1)
39  CALL SCOPY(ip1jm * klevel, ycov, 1, gdy, 1)
40  !
41  DO iter = 1, ld
42    !
43    CALL  diverg(klevel, gdx, gdy, div)
44    CALL filtreg(div, jjp1, klevel, 2, 1, .TRUE., 2)
45    CALL    grad(klevel, div, gdx, gdy)
46    !
47    DO l = 1, klevel
48      DO ij = 1, ip1jmp1
49        gdx(ij, l) = - gdx(ij, l) * cdivu
50      END DO
51      DO ij = 1, ip1jm
52        gdy(ij, l) = - gdy(ij, l) * cdivu
53      END DO
54    END DO
55    !
56  END DO
57  RETURN
58END SUBROUTINE gradiv
Note: See TracBrowser for help on using the repository browser.