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

Last change on this file since 5140 was 5134, checked in by abarral, 6 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
RevLine 
[524]1! $Header$
[5099]2
[5119]3SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy)
[5105]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  !
[5106]18  USE lmdz_filtreg, ONLY: filtreg
[5119]19  USE lmdz_ssum_scopy, ONLY: scopy
[5134]20  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
[5119]21
[5105]22  IMPLICIT NONE
23  !
[5134]24  INCLUDE "dimensions.h"
25  INCLUDE "paramet.h"
[524]26
[5105]27  INTEGER :: klevel
28  !
[5119]29  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
30  REAL :: gdx(ip1jmp1, klevel), gdy(ip1jm, klevel)
[524]31
[5119]32  REAL :: div(ip1jmp1, llm)
[524]33
[5119]34  INTEGER :: l, ij, iter, ld
[5105]35  !
36  !
37  !
[5119]38  CALL SCOPY(ip1jmp1 * klevel, xcov, 1, gdx, 1)
39  CALL SCOPY(ip1jm * klevel, ycov, 1, gdy, 1)
[5105]40  !
[5119]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    !
[5105]56  END DO
57  RETURN
58END SUBROUTINE gradiv
Note: See TracBrowser for help on using the repository browser.