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

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