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

Last change on this file since 2250 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
RevLine 
[764]1      SUBROUTINE gradiv_p(klevel, xcov, ycov, ld, gdx_out, gdy_out )
[630]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     
[1823]16      USE parallel_lmdz
[630]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 )
[764]28      REAL,SAVE :: gdx( ip1jmp1,llm ),   gdy( ip1jm,llm )
[630]29
[764]30      REAL gdx_out( ip1jmp1,klevel ),   gdy_out( ip1jm,klevel )
[630]31
[764]32      REAL,SAVE ::  div(ip1jmp1,llm)
33
[630]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
[764]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     
[630]51      ijb=ij_begin
52      ije=ij_end
53      if(pole_sud) ije=ij_end-iip1
[764]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
[630]61c
62      DO 10 iter = 1,ld
[764]63
64c$OMP BARRIER
65c$OMP MASTER     
[630]66      call suspend_timer(timer_dissip)
67      call exchange_Hallo(gdy,ip1jm,llm,1,0)
68      call resume_timer(timer_dissip)
[764]69c$OMP END MASTER     
70c$OMP BARRIER
71
[630]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)
[764]79
80c$OMP BARRIER
81c$OMP MASTER       
[630]82      call suspend_timer(timer_dissip)
83      call exchange_Hallo(div,ip1jmp1,llm,1,1)
84      call resume_timer(timer_dissip)
[764]85c$OMP END MASTER
86c$OMP BARRIER
[630]87     
88      CALL    grad_p( klevel,  div, gdx, gdy           )
89c
[764]90
91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]92      DO 5  l = 1, klevel
93     
94      if(pole_sud) ije=ij_end
95      DO 3 ij = ijb, ije
[764]96        gdx_out( ij,l ) = - gdx( ij,l ) * cdivu
[630]97   3  CONTINUE
98   
99      if(pole_sud) ije=ij_end-iip1
100      DO 4 ij = ijb, ije
[764]101        gdy_out( ij,l ) = - gdy( ij,l ) * cdivu
[630]102   4  CONTINUE
103
104   5  CONTINUE
[764]105c$OMP END DO NOWAIT
[630]106c
107  10  CONTINUE
108      RETURN
109      END
Note: See TracBrowser for help on using the repository browser.