source: LMDZ6/branches/contrails/libf/dyn3d_common/nxgraro2.f90 @ 5451

Last change on this file since 5451 was 5285, checked in by abarral, 2 months ago

As discussed internally, remove generic ONLY: ... for new _mod_h 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
Line 
1!
2! $Header$
3!
4 SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry )
5  !
6  !  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 comdissipn_mod_h
18  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
19USE paramet_mod_h
20IMPLICIT NONE
21  !
22
23
24  !
25  !    ......  variables en arguments  .......
26  !
27  INTEGER :: klevel
28  REAL :: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
29  REAL :: grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
30  !
31  !    ......   variables locales     ........
32  !
33  REAL :: rot(ip1jm,llm) , signe, nugradrs
34  INTEGER :: l,ij,iter,lr
35  !    ........................................................
36  !
37  !
38  !
39  signe    = (-1.)**lr
40  nugradrs = signe * crot
41  !
42  CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
43  CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
44  !
45  CALL     rotatf     ( klevel, grx, gry, rot )
46  !
47  CALL laplacien_rot ( klevel, rot, rot,grx,gry      )
48
49  !
50  !    .....   Iteration de l'operateur laplacien_rotgam  .....
51  !
52  DO  iter = 1, lr -2
53    CALL laplacien_rotgam ( klevel, rot, rot )
54  ENDDO
55  !
56  !
57  CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
58  CALL nxgrad ( klevel, rot, grx, gry )
59  !
60  DO    l = 1, klevel
61     DO  ij = 1, ip1jm
62      gry( ij,l ) = gry( ij,l ) * nugradrs
63     ENDDO
64     DO  ij = 1, ip1jmp1
65      grx( ij,l ) = grx( ij,l ) * nugradrs
66     ENDDO
67  ENDDO
68  !
69  RETURN
70END SUBROUTINE nxgraro2
Note: See TracBrowser for help on using the repository browser.