source: LMDZ5/trunk/libf/divgrad2_loc.F @ 1630

Last change on this file since 1630 was 1630, checked in by Laurent Fairhead, 12 years ago

Importation initiale du répertoire dyn3dmem


Initial import of dyn3dmem directory

File size: 3.1 KB
Line 
1      SUBROUTINE divgrad2_loc ( 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      USE mod_hallo
15      USE divgrad2_mod
16      IMPLICIT NONE
17c
18#include "dimensions.h"
19#include "paramet.h"
20#include "comgeom2.h"
21#include "comdissipn.h"
22
23c    .......    variables en arguments   .......
24c
25      INTEGER klevel
26      REAL h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel )
27      REAL divgra_out( ijb_u:ije_u,klevel)
28c    .......    variables  locales    ..........
29c
30      REAL     signe, nudivgrs, sqrtps( ijb_u:ije_u,llm )
31      INTEGER  l,ij,iter,lh
32c    ...................................................................
33      Type(Request) :: request_dissip
34      INTEGER ijb,ije
35
36c
37c
38      signe    = (-1.)**lh
39      nudivgrs = signe * cdivh
40
41c      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
42      ijb=ij_begin
43      ije=ij_end
44c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
45      DO l = 1, klevel
46        divgra(ijb:ije,l)=h(ijb:ije,l)
47      ENDDO
48c$OMP END DO NOWAIT
49c
50c$OMP BARRIER
51       call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
52       call SendRequest(Request_dissip)
53c$OMP BARRIER
54       call WaitRequest(Request_dissip)
55c$OMP BARRIER
56
57      CALL laplacien_loc( klevel, divgra, divgra )
58
59c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
60      DO l = 1, klevel
61       DO ij = ijb, ije
62        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
63       ENDDO
64      ENDDO
65c$OMP END DO NOWAIT
66
67c
68c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
69      DO l = 1, klevel
70        DO ij = ijb, ije
71         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
72        ENDDO
73      ENDDO
74c$OMP END DO NOWAIT
75   
76c    ........    Iteration de l'operateur  laplacien_gam    ........
77c
78      DO  iter = 1, lh - 2
79c$OMP BARRIER
80       call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
81       call SendRequest(Request_dissip)
82c$OMP BARRIER
83       call WaitRequest(Request_dissip)
84
85c$OMP BARRIER
86
87
88       CALL laplacien_gam_loc(klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
89     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
90      ENDDO
91c
92c    ...............................................................
93
94c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
95      DO l = 1, klevel
96        DO ij = ijb, ije
97          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
98        ENDDO
99      ENDDO
100c$OMP END DO NOWAIT
101c
102c$OMP BARRIER
103       call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
104       call SendRequest(Request_dissip)
105c$OMP BARRIER
106       call WaitRequest(Request_dissip)
107c$OMP BARRIER
108
109      CALL laplacien_loc ( klevel, divgra, divgra )
110c
111c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
112      DO l  = 1,klevel
113      DO ij = ijb,ije
114      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
115      ENDDO
116      ENDDO
117c$OMP END DO NOWAIT
118
119      RETURN
120      END
Note: See TracBrowser for help on using the repository browser.