source: LMDZ4/trunk/libf/dyn3dpar/divgrad2_p.F @ 953

Last change on this file since 953 was 764, checked in by Laurent Fairhead, 17 years ago

Merge entre la version V3_conv et le HEAD
YM, JG, LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
RevLine 
[764]1      SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out )
[630]2c
3c     P. Le Van
4c
5c   ***************************************************************
6c
7c     .....   calcul de  (div( grad ))   de (  pext * h ) .....
8c   ****************************************************************
9c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
10c         divgra     est  un argument  de sortie pour le s-prg
11c
12      USE parallel
13      USE times
14      IMPLICIT NONE
15c
16#include "dimensions.h"
17#include "paramet.h"
18#include "comgeom2.h"
19#include "comdissipn.h"
20
21c    .......    variables en arguments   .......
22c
23      INTEGER klevel
24      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
[764]25      REAL divgra_out( ip1jmp1,klevel)
26      REAL,SAVE :: divgra( ip1jmp1,llm)
27
[630]28c
29c    .......    variables  locales    ..........
30c
31      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
32      INTEGER  l,ij,iter,lh
33c    ...................................................................
34
35      INTEGER ijb,ije
36c
37      signe    = (-1.)**lh
38      nudivgrs = signe * cdivh
39
40c      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
41      ijb=ij_begin
42      ije=ij_end
[764]43c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
44      DO l = 1, klevel
45        divgra(ijb:ije,l)=h(ijb:ije,l)
46      ENDDO
47c$OMP END DO NOWAIT
[630]48c
[764]49c$OMP BARRIER
50c$OMP MASTER
[630]51      call suspend_timer(timer_dissip)
52      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
53      call resume_timer(timer_dissip)
[764]54c$OMP END MASTER
55c$OMP BARRIER
[630]56      CALL laplacien_p( klevel, divgra, divgra )
[764]57
58c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]59      DO l = 1, klevel
60       DO ij = ijb, ije
61        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
62       ENDDO
63      ENDDO
[764]64c$OMP END DO NOWAIT
65
[630]66c
[764]67c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]68      DO l = 1, klevel
69        DO ij = ijb, ije
70         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
71        ENDDO
72      ENDDO
[764]73c$OMP END DO NOWAIT
[630]74   
75c    ........    Iteration de l'operateur  laplacien_gam    ........
76c
77      DO  iter = 1, lh - 2
[764]78c$OMP BARRIER
79c$OMP MASTER
[630]80       call suspend_timer(timer_dissip)
81       call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
82       call resume_timer(timer_dissip)
[764]83c$OMP END MASTER
84c$OMP BARRIER
[630]85       CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
86     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
87      ENDDO
88c
89c    ...............................................................
[764]90
91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]92      DO l = 1, klevel
93        DO ij = ijb, ije
94          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
95        ENDDO
96      ENDDO
[764]97c$OMP END DO NOWAIT
[630]98c
[764]99c$OMP BARRIER
100c$OMP MASTER
[630]101      call suspend_timer(timer_dissip)
102      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
103      call resume_timer(timer_dissip)
[764]104c$OMP END MASTER
105c$OMP BARRIER
106
[630]107      CALL laplacien_p ( klevel, divgra, divgra )
108c
[764]109c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]110      DO l  = 1,klevel
111      DO ij = ijb,ije
[764]112      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
[630]113      ENDDO
114      ENDDO
[764]115c$OMP END DO NOWAIT
[630]116
117      RETURN
118      END
Note: See TracBrowser for help on using the repository browser.