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

Last change on this file since 801 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
Line 
1      SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out )
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 )
25      REAL divgra_out( ip1jmp1,klevel)
26      REAL,SAVE :: divgra( ip1jmp1,llm)
27
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
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
48c
49c$OMP BARRIER
50c$OMP MASTER
51      call suspend_timer(timer_dissip)
52      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
53      call resume_timer(timer_dissip)
54c$OMP END MASTER
55c$OMP BARRIER
56      CALL laplacien_p( klevel, divgra, divgra )
57
58c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
59      DO l = 1, klevel
60       DO ij = ijb, ije
61        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
62       ENDDO
63      ENDDO
64c$OMP END DO NOWAIT
65
66c
67c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
68      DO l = 1, klevel
69        DO ij = ijb, ije
70         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
71        ENDDO
72      ENDDO
73c$OMP END DO NOWAIT
74   
75c    ........    Iteration de l'operateur  laplacien_gam    ........
76c
77      DO  iter = 1, lh - 2
78c$OMP BARRIER
79c$OMP MASTER
80       call suspend_timer(timer_dissip)
81       call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
82       call resume_timer(timer_dissip)
83c$OMP END MASTER
84c$OMP BARRIER
85       CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
86     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
87      ENDDO
88c
89c    ...............................................................
90
91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
92      DO l = 1, klevel
93        DO ij = ijb, ije
94          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
95        ENDDO
96      ENDDO
97c$OMP END DO NOWAIT
98c
99c$OMP BARRIER
100c$OMP MASTER
101      call suspend_timer(timer_dissip)
102      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
103      call resume_timer(timer_dissip)
104c$OMP END MASTER
105c$OMP BARRIER
106
107      CALL laplacien_p ( klevel, divgra, divgra )
108c
109c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
110      DO l  = 1,klevel
111      DO ij = ijb,ije
112      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
113      ENDDO
114      ENDDO
115c$OMP END DO NOWAIT
116
117      RETURN
118      END
Note: See TracBrowser for help on using the repository browser.