/[lmdze]/trunk/dyn3d/Dissipation/nxgraro2.f
ViewVC logotype

Annotation of /trunk/dyn3d/Dissipation/nxgraro2.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 3 months ago) by guez
Original Path: trunk/libf/dyn3d/nxgraro2.f
File size: 1851 byte(s)
Initial import
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/nxgraro2.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $
3     !
4     SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry )
5     c
6     c P.Le Van .
7     c ***********************************************************
8     c lr
9     c calcul de ( nxgrad (rot) ) du vect. v ....
10     c
11     c xcov et ycov etant les compos. covariantes de v
12     c ***********************************************************
13     c xcov , ycov et lr sont des arguments d'entree pour le s-prog
14     c grx et gry sont des arguments de sortie pour le s-prog
15     c
16     c
17     use dimens_m
18     use paramet_m
19     IMPLICIT NONE
20     c
21     include "comdissipn.h"
22     c
23     c ...... variables en arguments .......
24     c
25     INTEGER klevel
26     REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
27     REAL grx( ip1jmp1,klevel ), gry( ip1jm,klevel )
28     c
29     c ...... variables locales ........
30     c
31     REAL rot(ip1jm,llm) , signe, nugradrs
32     INTEGER l,ij,iter,lr
33     c ........................................................
34     c
35     c
36     c
37     signe = (-1.)**lr
38     nugradrs = signe * crot
39     c
40     CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
41     CALL SCOPY ( ip1jm * klevel, ycov, 1, gry, 1 )
42     c
43     CALL rotatf ( klevel, grx, gry, rot )
44     c
45     CALL laplacien_rot ( klevel, rot, rot,grx,gry )
46    
47     c
48     c ..... Iteration de l'operateur laplacien_rotgam .....
49     c
50     DO iter = 1, lr -2
51     CALL laplacien_rotgam ( klevel, rot, rot )
52     ENDDO
53     c
54     c
55     CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
56     CALL nxgrad ( klevel, rot, grx, gry )
57     c
58     DO l = 1, klevel
59     DO ij = 1, ip1jm
60     gry( ij,l ) = gry( ij,l ) * nugradrs
61     ENDDO
62     DO ij = 1, ip1jmp1
63     grx( ij,l ) = grx( ij,l ) * nugradrs
64     ENDDO
65     ENDDO
66     c
67     RETURN
68     END

  ViewVC Help
Powered by ViewVC 1.1.21