source: LMDZ6/branches/DYNAMICO-conv/libf/dyn3dpar/divgrad2_p.F @ 3024

Last change on this file since 3024 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 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_lmdz
13      USE times
14      USE mod_hallo
15      IMPLICIT NONE
16c
17#include "dimensions.h"
18#include "paramet.h"
19#include "comgeom2.h"
20#include "comdissipn.h"
21
22c    .......    variables en arguments   .......
23c
24      INTEGER klevel
25      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
26      REAL divgra_out( ip1jmp1,klevel)
27      REAL,SAVE :: divgra( ip1jmp1,llm)
28
29c
30c    .......    variables  locales    ..........
31c
32      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
33      INTEGER  l,ij,iter,lh
34c    ...................................................................
35      Type(Request) :: request_dissip
36      INTEGER ijb,ije
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(divgra,ip1jmp1,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_p( 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(divgra,ip1jmp1,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_p ( 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(divgra,ip1jmp1,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_p ( 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.