source: LMDZ6/trunk/libf/dyn3dmem/divgrad2_loc.F @ 5184

Last change on this file since 5184 was 4593, checked in by yann meurdesoif, 18 months ago

Replace #include (c preprocessor) by INCLUDE (fortran keyword)

in phylmd (except rrtm and ecrad) filtrez, dy3dmem and dyn3dcommon

Other directories will follow
YM

  • 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
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_lmdz
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),SAVE :: request_dissip
34!$OMP THREADPRIVATE(request_dissip)
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.