source: LMDZ4/branches/LMDZ4_par_0/libf/dyn3dpar/gradiv2_p.F @ 5379

Last change on this file since 5379 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.3 KB
Line 
1      SUBROUTINE gradiv2_p(klevel, xcov, ycov, ld, gdx, gdy )
2c
3c     P. Le Van
4c
5c   **********************************************************
6c                                ld
7c       calcul  de  (grad (div) )   du vect. v ....
8c
9c     xcov et ycov etant les composant.covariantes de v
10c   **********************************************************
11c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
12c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
13c
14c
15      USE parallel
16      USE times
17      USE Write_field_p
18      IMPLICIT NONE
19c
20#include "dimensions.h"
21#include "paramet.h"
22#include "comgeom.h"
23#include "comdissipn.h"
24c
25c     ........    variables en arguments      ........
26
27      INTEGER klevel
28      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
29      REAL   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
30c
31c     ........       variables locales       .........
32c
33      REAL div(ip1jmp1,llm)
34      REAL signe, nugrads
35      INTEGER l,ij,iter,ld
36      INTEGER :: ijb,ije,jjb,jje
37     
38c    ........................................................
39c
40      EXTERNAL   SCOPY, divergf, grad, laplacien_gam, filtreg
41c
42c      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
43c      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
44     
45      ijb=ij_begin
46      ije=ij_end
47      gdx(ijb:ije,1:klevel)=xcov(ijb:ije,1:klevel)
48
49     
50      ijb=ij_begin
51      ije=ij_end
52      if(pole_sud) ije=ij_end-iip1
53      gdy(ijb:ije,1:klevel)=ycov(ijb:ije,1:klevel)
54     
55      call suspend_timer(timer_dissip)
56      call exchange_Hallo(gdy,ip1jm,llm,1,0)
57      call resume_timer(timer_dissip)
58c
59c
60      signe   = (-1.)**ld
61      nugrads = signe * cdivu
62c
63
64
65      CALL    divergf_p( klevel, gdx,   gdy , div )
66c      call write_field3d_p('div1',reshape(div,(/iip1,jjp1,llm/)))
67
68      IF( ld.GT.1 )   THEN
69       
70        call suspend_timer(timer_dissip)
71        call exchange_Hallo(div,ip1jmp1,llm,1,1)
72        call resume_timer(timer_dissip)
73       
74        CALL laplacien_p ( klevel, div,  div     )
75
76c    ......  Iteration de l'operateur laplacien_gam   .......
77c         call write_field3d_p('div2',reshape(div,(/iip1,jjp1,llm/)))
78
79        DO iter = 1, ld -2
80         call suspend_timer(timer_dissip)
81         call exchange_Hallo(div,ip1jmp1,llm,1,1)
82         call resume_timer(timer_dissip)
83         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
84     *                       unsapolnga1, unsapolsga1,  div, div       )
85        ENDDO
86c        call write_field3d_p('div3',reshape(div,(/iip1,jjp1,llm/)))
87      ENDIF
88
89       jjb=jj_begin
90       jje=jj_end
91       
92       CALL filtreg_p( div   ,jjb,jje, jjp1, klevel, 2, 1, .TRUE., 1 )
93c       call exchange_Hallo(div,ip1jmp1,llm,0,1)
94       
95        call suspend_timer(timer_dissip)
96        call exchange_Hallo(div,ip1jmp1,llm,1,1)
97        call resume_timer(timer_dissip)
98
99c       call write_field3d_p('div4',reshape(div,(/iip1,jjp1,llm/)))
100       CALL  grad_p  ( klevel,  div,   gdx,  gdy             )
101
102c
103      ijb=ij_begin
104      ije=ij_end
105         
106     
107       DO   l = 1, klevel
108         
109         if (pole_sud) ije=ij_end
110         DO  ij = ijb, ije
111          gdx( ij,l ) = gdx( ij,l ) * nugrads
112         ENDDO
113         
114         if (pole_sud) ije=ij_end-iip1
115         DO  ij = ijb, ije
116          gdy( ij,l ) = gdy( ij,l ) * nugrads
117         ENDDO
118       
119       ENDDO
120c
121       RETURN
122       END
Note: See TracBrowser for help on using the repository browser.