source: LMDZ5/trunk/libf/dyn3dpar/divgrad2_p.F @ 4249

Last change on this file since 4249 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
RevLine 
[764]1      SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out )
[630]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
[630]13      USE times
[985]14      USE mod_hallo
[630]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 )
[764]26      REAL divgra_out( ip1jmp1,klevel)
27      REAL,SAVE :: divgra( ip1jmp1,llm)
28
[630]29c
30c    .......    variables  locales    ..........
31c
32      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
33      INTEGER  l,ij,iter,lh
34c    ...................................................................
[985]35      Type(Request) :: request_dissip
[630]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
[764]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
[630]49c
[764]50c$OMP BARRIER
[985]51       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
52       call SendRequest(Request_dissip)
[764]53c$OMP BARRIER
[985]54       call WaitRequest(Request_dissip)
55c$OMP BARRIER
56
[630]57      CALL laplacien_p( klevel, divgra, divgra )
[764]58
59c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]60      DO l = 1, klevel
61       DO ij = ijb, ije
62        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
63       ENDDO
64      ENDDO
[764]65c$OMP END DO NOWAIT
66
[630]67c
[764]68c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]69      DO l = 1, klevel
70        DO ij = ijb, ije
71         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
72        ENDDO
73      ENDDO
[764]74c$OMP END DO NOWAIT
[630]75   
76c    ........    Iteration de l'operateur  laplacien_gam    ........
77c
78      DO  iter = 1, lh - 2
[764]79c$OMP BARRIER
[985]80       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
81       call SendRequest(Request_dissip)
[764]82c$OMP BARRIER
[985]83       call WaitRequest(Request_dissip)
84
85c$OMP BARRIER
86
87
[630]88       CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
89     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
90      ENDDO
91c
92c    ...............................................................
[764]93
94c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]95      DO l = 1, klevel
96        DO ij = ijb, ije
97          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
98        ENDDO
99      ENDDO
[764]100c$OMP END DO NOWAIT
[630]101c
[764]102c$OMP BARRIER
[985]103       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
104       call SendRequest(Request_dissip)
[764]105c$OMP BARRIER
[985]106       call WaitRequest(Request_dissip)
107c$OMP BARRIER
[764]108
[630]109      CALL laplacien_p ( klevel, divgra, divgra )
110c
[764]111c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]112      DO l  = 1,klevel
113      DO ij = ijb,ije
[764]114      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
[630]115      ENDDO
116      ENDDO
[764]117c$OMP END DO NOWAIT
[630]118
119      RETURN
120      END
Note: See TracBrowser for help on using the repository browser.