source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgraro2.f90 @ 5423

Last change on this file since 5423 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.7 KB
RevLine 
[524]1! $Header$
[5099]2
[5119]3SUBROUTINE nxgraro2(klevel, xcov, ycov, lr, grx, gry)
[5159]4
[5105]5  !  P.Le Van .
6  !   ***********************************************************
7  !                             lr
8  !  calcul de  ( nxgrad (rot) )   du vect. v  ....
[5159]9
[5105]10  !   xcov et ycov  etant les compos. covariantes de  v
11  !   ***********************************************************
12  ! xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
13  !  grx   et  gry     sont des arguments de sortie pour le s-prog
[5159]14
15
[5106]16  USE lmdz_filtreg, ONLY: filtreg
[5119]17  USE lmdz_ssum_scopy, ONLY: scopy
[5134]18  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
[5119]19
[5159]20USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
21  USE lmdz_paramet
[5105]22  IMPLICIT NONE
23  !
[5159]24
25
26
[5105]27  !    ......  variables en arguments  .......
[5159]28
[5105]29  INTEGER :: klevel
[5119]30  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
31  REAL :: grx(ip1jmp1, klevel), gry(ip1jm, klevel)
[5159]32
[5105]33  !    ......   variables locales     ........
[5159]34
[5119]35  REAL :: rot(ip1jm, llm), signe, nugradrs
36  INTEGER :: l, ij, iter, lr
[5105]37  !    ........................................................
[5159]38
39
40
[5119]41  signe = (-1.)**lr
[5105]42  nugradrs = signe * crot
[5159]43
[5119]44  CALL SCOPY (ip1jmp1 * klevel, xcov, 1, grx, 1)
45  CALL SCOPY (ip1jm * klevel, ycov, 1, gry, 1)
[5159]46
[5119]47  CALL     rotatf     (klevel, grx, gry, rot)
[5159]48
[5119]49  CALL laplacien_rot (klevel, rot, rot, grx, gry)
[524]50
[5159]51
[5105]52  !    .....   Iteration de l'operateur laplacien_rotgam  .....
[5159]53
[5119]54  DO  iter = 1, lr - 2
55    CALL laplacien_rotgam (klevel, rot, rot)
[5105]56  ENDDO
[5159]57
58
[5119]59  CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE., 1)
60  CALL nxgrad (klevel, rot, grx, gry)
[5159]61
[5105]62  DO    l = 1, klevel
[5119]63    DO  ij = 1, ip1jm
64      gry(ij, l) = gry(ij, l) * nugradrs
65    ENDDO
66    DO  ij = 1, ip1jmp1
67      grx(ij, l) = grx(ij, l) * nugradrs
68    ENDDO
[5105]69  ENDDO
[5159]70
[5105]71  RETURN
72END SUBROUTINE nxgraro2
Note: See TracBrowser for help on using the repository browser.