source: LMDZ4/trunk/libf/dyn3dpar/nxgraro2_p.F @ 701

Last change on this file since 701 was 630, checked in by Laurent Fairhead, 20 years ago

Import d'une version parallele de la dynamique YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
Line 
1       SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx, gry )
2c
3c      P.Le Van .
4c   ***********************************************************
5c                                 lr
6c      calcul de  ( nxgrad (rot) )   du vect. v  ....
7c
8c       xcov et ycov  etant les compos. covariantes de  v
9c   ***********************************************************
10c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
11c      grx   et  gry     sont des arguments de sortie pour le s-prog
12c
13c
14      USE write_Field_p
15      USE parallel
16      USE times
17      IMPLICIT NONE
18c
19#include "dimensions.h"
20#include "paramet.h"
21#include "comdissipn.h"
22c
23c    ......  variables en arguments  .......
24c
25      INTEGER klevel
26      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
27      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
28c
29c    ......   variables locales     ........
30c
31      REAL rot(ip1jm,llm) , signe, nugradrs
32      INTEGER l,ij,iter,lr
33c    ........................................................
34c
35      EXTERNAL    filtreg
36      EXTERNAL  SCOPY, rotatf, nxgrad, laplacien_rotgam
37      INTEGER :: ijb,ije,jjb,jje
38     
39c
40c
41      signe    = (-1.)**lr
42      nugradrs = signe * crot
43c
44c      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
45c      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
46 
47      ijb=ij_begin
48      ije=ij_end
49      grx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)
50     
51      call suspend_timer(timer_dissip)
52      call exchange_Hallo(grx,ip1jmp1,llm,0,1)
53      call resume_timer(timer_dissip)
54
55      ijb=ij_begin
56      ije=ij_end
57      if(pole_sud) ije=ij_end-iip1
58      gry(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel)
59c
60      CALL     rotatf_p     ( klevel, grx, gry, rot )
61c      call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
62     
63      call suspend_timer(timer_dissip)
64      call exchange_Hallo(rot,ip1jm,llm,1,1)
65      call resume_timer(timer_dissip)
66     
67      CALL laplacien_rot_p ( klevel, rot, rot,grx,gry      )
68c       call write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))
69c
70c    .....   Iteration de l'operateur laplacien_rotgam  .....
71c
72      DO  iter = 1, lr -2
73        call suspend_timer(timer_dissip)
74        call exchange_Hallo(rot,ip1jm,llm,1,1)
75        call resume_timer(timer_dissip)
76        CALL laplacien_rotgam_p ( klevel, rot, rot )
77      ENDDO
78     
79c       call write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))
80     
81c
82c
83      jjb=jj_begin
84      jje=jj_end
85      if (pole_sud) jje=jj_end-1
86       
87      CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2,1, .FALSE.,1)
88      call suspend_timer(timer_dissip)
89      call exchange_Hallo(rot,ip1jm,llm,1,0)
90      call resume_timer(timer_dissip)
91      CALL nxgrad_p ( klevel, rot, grx, gry )
92
93c
94      ijb=ij_begin
95      ije=ij_end
96   
97      DO    l = 1, klevel
98       
99         if(pole_sud) ije=ij_end-iip1
100         DO  ij = ijb, ije
101          gry( ij,l ) = gry( ij,l ) * nugradrs
102         ENDDO
103       
104         if(pole_sud) ije=ij_end
105         DO  ij = ijb, ije
106          grx( ij,l ) = grx( ij,l ) * nugradrs
107         ENDDO
108     
109      ENDDO
110c
111      RETURN
112      END
Note: See TracBrowser for help on using the repository browser.