source: LMDZ5/trunk/libf/dyn3dpar/gradiv_p.F @ 2097

Last change on this file since 2097 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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: 2.5 KB
Line 
1      SUBROUTINE gradiv_p(klevel, xcov, ycov, ld, gdx_out, gdy_out )
2c
3c    Auteur :   P. Le Van
4c
5c   ***************************************************************
6c
7c                                ld
8c       calcul  de  (grad (div) )   du vect. v ....
9c
10c     xcov et ycov etant les composant.covariantes de v
11c   ****************************************************************
12c    xcov , ycov et ld  sont des arguments  d'entree pour le s-prog
13c     gdx   et  gdy     sont des arguments de sortie pour le s-prog
14c
15c     
16      USE parallel_lmdz
17      USE times
18      IMPLICIT NONE
19c
20#include "dimensions.h"
21#include "paramet.h"
22#include "comdissipn.h"
23#include "logic.h"
24
25      INTEGER klevel
26c
27      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
28      REAL,SAVE :: gdx( ip1jmp1,llm ),   gdy( ip1jm,llm )
29
30      REAL gdx_out( ip1jmp1,klevel ),   gdy_out( ip1jm,klevel )
31
32      REAL,SAVE ::  div(ip1jmp1,llm)
33
34      INTEGER l,ij,iter,ld
35c
36      INTEGER ijb,ije,jjb,jje
37c
38c
39c      CALL SCOPY( ip1jmp1*klevel,xcov,1,gdx,1 )
40c      CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
41     
42      ijb=ij_begin
43      ije=ij_end
44
45c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
46      DO l = 1,klevel
47        gdx(ijb:ije,l)=xcov(ijb:ije,l)
48      ENDDO
49c$OMP END DO NOWAIT
50     
51      ijb=ij_begin
52      ije=ij_end
53      if(pole_sud) ije=ij_end-iip1
54
55c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
56      DO l = 1,klevel
57        gdy(ijb:ije,l)=ycov(ijb:ije,l)
58      ENDDO
59c$OMP END DO NOWAIT
60
61c
62      DO 10 iter = 1,ld
63
64c$OMP BARRIER
65c$OMP MASTER     
66      call suspend_timer(timer_dissip)
67      call exchange_Hallo(gdy,ip1jm,llm,1,0)
68      call resume_timer(timer_dissip)
69c$OMP END MASTER     
70c$OMP BARRIER
71
72      CALL  diverg_p( klevel,  gdx , gdy, div          )
73     
74      jjb=jj_begin
75      jje=jj_end
76      CALL filtreg_p( div,jjb,jje, jjp1, klevel, 2,1, .true.,2 )
77     
78c      call exchange_Hallo(div,ip1jmp1,llm,0,1)
79
80c$OMP BARRIER
81c$OMP MASTER       
82      call suspend_timer(timer_dissip)
83      call exchange_Hallo(div,ip1jmp1,llm,1,1)
84      call resume_timer(timer_dissip)
85c$OMP END MASTER
86c$OMP BARRIER
87     
88      CALL    grad_p( klevel,  div, gdx, gdy           )
89c
90
91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
92      DO 5  l = 1, klevel
93     
94      if(pole_sud) ije=ij_end
95      DO 3 ij = ijb, ije
96        gdx_out( ij,l ) = - gdx( ij,l ) * cdivu
97   3  CONTINUE
98   
99      if(pole_sud) ije=ij_end-iip1
100      DO 4 ij = ijb, ije
101        gdy_out( ij,l ) = - gdy( ij,l ) * cdivu
102   4  CONTINUE
103
104   5  CONTINUE
105c$OMP END DO NOWAIT
106c
107  10  CONTINUE
108      RETURN
109      END
Note: See TracBrowser for help on using the repository browser.