source: LMDZ5/trunk/libf/dyn3dmem/divgrad2_loc.F @ 4002

Last change on this file since 4002 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
File size: 3.1 KB
RevLine 
[1632]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
[1823]12      USE parallel_lmdz
[1632]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    ...................................................................
[1848]33      Type(Request),SAVE :: request_dissip
34!$OMP THREADPRIVATE(request_dissip)
[1632]35      INTEGER ijb,ije
36
37c
38c
39      signe    = (-1.)**lh
40      nudivgrs = signe * cdivh
41
42c      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
43      ijb=ij_begin
44      ije=ij_end
45c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
46      DO l = 1, klevel
47        divgra(ijb:ije,l)=h(ijb:ije,l)
48      ENDDO
49c$OMP END DO NOWAIT
50c
51c$OMP BARRIER
52       call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
53       call SendRequest(Request_dissip)
54c$OMP BARRIER
55       call WaitRequest(Request_dissip)
56c$OMP BARRIER
57
58      CALL laplacien_loc( klevel, divgra, divgra )
59
60c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
61      DO l = 1, klevel
62       DO ij = ijb, ije
63        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
64       ENDDO
65      ENDDO
66c$OMP END DO NOWAIT
67
68c
69c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
70      DO l = 1, klevel
71        DO ij = ijb, ije
72         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
73        ENDDO
74      ENDDO
75c$OMP END DO NOWAIT
76   
77c    ........    Iteration de l'operateur  laplacien_gam    ........
78c
79      DO  iter = 1, lh - 2
80c$OMP BARRIER
81       call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
82       call SendRequest(Request_dissip)
83c$OMP BARRIER
84       call WaitRequest(Request_dissip)
85
86c$OMP BARRIER
87
88
89       CALL laplacien_gam_loc(klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
90     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
91      ENDDO
92c
93c    ...............................................................
94
95c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
96      DO l = 1, klevel
97        DO ij = ijb, ije
98          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
99        ENDDO
100      ENDDO
101c$OMP END DO NOWAIT
102c
103c$OMP BARRIER
104       call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
105       call SendRequest(Request_dissip)
106c$OMP BARRIER
107       call WaitRequest(Request_dissip)
108c$OMP BARRIER
109
110      CALL laplacien_loc ( klevel, divgra, divgra )
111c
112c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
113      DO l  = 1,klevel
114      DO ij = ijb,ije
115      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
116      ENDDO
117      ENDDO
118c$OMP END DO NOWAIT
119
120      RETURN
121      END
Note: See TracBrowser for help on using the repository browser.