source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgrarot.f90 @ 5136

Last change on this file since 5136 was 5134, checked in by abarral, 8 weeks 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 nxgrarot(klevel, xcov, ycov, lr, grx, gry)
4  !   ***********************************************************
5  !
6  !    Auteur :  P.Le Van
7  !
8  !                             lr
9  !  calcul de  ( nXgrad (rot) )   du vect. v  ....
10  !
11  !   xcov et ycov  etant les compos. covariantes de  v
12  !   ***********************************************************
13  ! xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
14  !  grx   et  gry     sont des arguments de sortie pour le s-prog
15  !
16  !
17  USE lmdz_filtreg, ONLY: filtreg
18  USE lmdz_ssum_scopy, ONLY: scopy
19  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
20
21  IMPLICIT NONE
22  !
23  !
24  INCLUDE "dimensions.h"
25  INCLUDE "paramet.h"
26  !
27  INTEGER :: klevel
28  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
29  REAL :: grx(ip1jmp1, klevel), gry(ip1jm, klevel)
30  !
31  REAL :: rot(ip1jm, llm)
32
33  INTEGER :: l, ij, iter, lr
34  !
35  !
36  !
37  CALL SCOPY (ip1jmp1 * klevel, xcov, 1, grx, 1)
38  CALL SCOPY (ip1jm * klevel, ycov, 1, gry, 1)
39  !
40  DO iter = 1, lr
41    CALL  rotat (klevel, grx, gry, rot)
42    CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE., 2)
43    CALL nxgrad (klevel, rot, grx, gry)
44    !
45    DO l = 1, klevel
46      DO ij = 1, ip1jm
47        gry(ij, l) = - gry(ij, l) * crot
48      END DO
49      DO ij = 1, ip1jmp1
50        grx(ij, l) = - grx(ij, l) * crot
51      END DO
52    END DO
53    !
54  END DO
55  RETURN
56END SUBROUTINE nxgrarot
Note: See TracBrowser for help on using the repository browser.