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

Last change on this file since 5360 was 2603, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn logic.h into module logic_mod.F90
EM

  • 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
24      INTEGER klevel
25c
26      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
[764]27      REAL,SAVE :: gdx( ip1jmp1,llm ),   gdy( ip1jm,llm )
[630]28
[764]29      REAL gdx_out( ip1jmp1,klevel ),   gdy_out( ip1jm,klevel )
[630]30
[764]31      REAL,SAVE ::  div(ip1jmp1,llm)
32
[630]33      INTEGER l,ij,iter,ld
34c
35      INTEGER ijb,ije,jjb,jje
36c
37c
38c      CALL SCOPY( ip1jmp1*klevel,xcov,1,gdx,1 )
39c      CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
40     
41      ijb=ij_begin
42      ije=ij_end
43
[764]44c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
45      DO l = 1,klevel
46        gdx(ijb:ije,l)=xcov(ijb:ije,l)
47      ENDDO
48c$OMP END DO NOWAIT
49     
[630]50      ijb=ij_begin
51      ije=ij_end
52      if(pole_sud) ije=ij_end-iip1
[764]53
54c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
55      DO l = 1,klevel
56        gdy(ijb:ije,l)=ycov(ijb:ije,l)
57      ENDDO
58c$OMP END DO NOWAIT
59
[630]60c
61      DO 10 iter = 1,ld
[764]62
63c$OMP BARRIER
64c$OMP MASTER     
[630]65      call suspend_timer(timer_dissip)
66      call exchange_Hallo(gdy,ip1jm,llm,1,0)
67      call resume_timer(timer_dissip)
[764]68c$OMP END MASTER     
69c$OMP BARRIER
70
[630]71      CALL  diverg_p( klevel,  gdx , gdy, div          )
72     
73      jjb=jj_begin
74      jje=jj_end
75      CALL filtreg_p( div,jjb,jje, jjp1, klevel, 2,1, .true.,2 )
76     
77c      call exchange_Hallo(div,ip1jmp1,llm,0,1)
[764]78
79c$OMP BARRIER
80c$OMP MASTER       
[630]81      call suspend_timer(timer_dissip)
82      call exchange_Hallo(div,ip1jmp1,llm,1,1)
83      call resume_timer(timer_dissip)
[764]84c$OMP END MASTER
85c$OMP BARRIER
[630]86     
87      CALL    grad_p( klevel,  div, gdx, gdy           )
88c
[764]89
90c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]91      DO 5  l = 1, klevel
92     
93      if(pole_sud) ije=ij_end
94      DO 3 ij = ijb, ije
[764]95        gdx_out( ij,l ) = - gdx( ij,l ) * cdivu
[630]96   3  CONTINUE
97   
98      if(pole_sud) ije=ij_end-iip1
99      DO 4 ij = ijb, ije
[764]100        gdy_out( ij,l ) = - gdy( ij,l ) * cdivu
[630]101   4  CONTINUE
102
103   5  CONTINUE
[764]104c$OMP END DO NOWAIT
[630]105c
106  10  CONTINUE
107      RETURN
108      END
Note: See TracBrowser for help on using the repository browser.