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

Last change on this file since 5441 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

  • 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  !   ***********************************************************
[5159]5
[5105]6  !    Auteur :  P.Le Van
[5159]7
[5105]8  !                             lr
9  !  calcul de  ( nXgrad (rot) )   du vect. v  ....
[5159]10
[5105]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
[5159]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
[5159]21USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
22  USE lmdz_paramet
[5105]23  IMPLICIT NONE
[5159]24
[5105]25  !
[5159]26
27
28
[5105]29  INTEGER :: klevel
[5119]30  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
31  REAL :: grx(ip1jmp1, klevel), gry(ip1jm, klevel)
[5159]32
[5119]33  REAL :: rot(ip1jm, llm)
[524]34
[5119]35  INTEGER :: l, ij, iter, lr
[5159]36
37
38
[5119]39  CALL SCOPY (ip1jmp1 * klevel, xcov, 1, grx, 1)
40  CALL SCOPY (ip1jm * klevel, ycov, 1, gry, 1)
[5159]41
[5119]42  DO iter = 1, lr
43    CALL  rotat (klevel, grx, gry, rot)
44    CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE., 2)
45    CALL nxgrad (klevel, rot, grx, gry)
[5159]46
[5119]47    DO l = 1, klevel
48      DO ij = 1, ip1jm
49        gry(ij, l) = - gry(ij, l) * crot
50      END DO
51      DO ij = 1, ip1jmp1
52        grx(ij, l) = - grx(ij, l) * crot
53      END DO
54    END DO
[5159]55
[5105]56  END DO
57  RETURN
58END SUBROUTINE nxgrarot
Note: See TracBrowser for help on using the repository browser.