source: LMDZ6/trunk/libf/dyn3dmem/divgrad2_loc.f90 @ 5279

Last change on this file since 5279 was 5272, checked in by abarral, 33 hours ago

Turn paramet.h into a module

  • 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 
1SUBROUTINE divgrad2_loc ( klevel, h, deltapres, lh, divgra_out )
2  !
3  ! P. Le Van
4  !
5  !   ***************************************************************
6  !
7  ! .....   calcul de  (div( grad ))   de (  pext * h ) .....
8  !   ****************************************************************
9  !   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
10  !     divgra     est  un argument  de sortie pour le s-prg
11  !
12  USE parallel_lmdz
13  USE times
14  USE mod_hallo
15  USE divgrad2_mod
16  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
17USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
18          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
19IMPLICIT NONE
20  !
21
22
23  INCLUDE "comgeom2.h"
24  INCLUDE "comdissipn.h"
25
26  !    .......    variables en arguments   .......
27  !
28  INTEGER :: klevel
29  REAL :: h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel )
30  REAL :: divgra_out( ijb_u:ije_u,klevel)
31  !    .......    variables  locales    ..........
32  !
33  REAL :: signe, nudivgrs, sqrtps( ijb_u:ije_u,llm )
34  INTEGER :: l,ij,iter,lh
35  !    ...................................................................
36  Type(Request),SAVE :: request_dissip
37!$OMP THREADPRIVATE(request_dissip)
38  INTEGER :: ijb,ije
39
40  !
41  !
42  signe    = (-1.)**lh
43  nudivgrs = signe * cdivh
44
45   ! CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
46  ijb=ij_begin
47  ije=ij_end
48!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
49  DO l = 1, klevel
50    divgra(ijb:ije,l)=h(ijb:ije,l)
51  ENDDO
52!$OMP END DO NOWAIT
53  !
54!$OMP BARRIER
55   call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
56   call SendRequest(Request_dissip)
57!$OMP BARRIER
58   call WaitRequest(Request_dissip)
59!$OMP BARRIER
60
61  CALL laplacien_loc( klevel, divgra, divgra )
62
63!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
64  DO l = 1, klevel
65   DO ij = ijb, ije
66    sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
67   ENDDO
68  ENDDO
69!$OMP END DO NOWAIT
70
71  !
72!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
73  DO l = 1, klevel
74    DO ij = ijb, ije
75     divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
76    ENDDO
77  ENDDO
78!$OMP END DO NOWAIT
79
80  !    ........    Iteration de l'operateur  laplacien_gam    ........
81  !
82  DO  iter = 1, lh - 2
83!$OMP BARRIER
84   call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
85   call SendRequest(Request_dissip)
86!$OMP BARRIER
87   call WaitRequest(Request_dissip)
88
89!$OMP BARRIER
90
91
92   CALL laplacien_gam_loc(klevel,cuvscvgam2,cvuscugam2,unsair_gam2, &
93         unsapolnga2, unsapolsga2,  divgra, divgra )
94  ENDDO
95  !
96  !    ...............................................................
97
98!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
99  DO l = 1, klevel
100    DO ij = ijb, ije
101      divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
102    ENDDO
103  ENDDO
104!$OMP END DO NOWAIT
105  !
106!$OMP BARRIER
107   call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
108   call SendRequest(Request_dissip)
109!$OMP BARRIER
110   call WaitRequest(Request_dissip)
111!$OMP BARRIER
112
113  CALL laplacien_loc ( klevel, divgra, divgra )
114  !
115!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
116  DO l  = 1,klevel
117  DO ij = ijb,ije
118  divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
119  ENDDO
120  ENDDO
121!$OMP END DO NOWAIT
122
123  RETURN
124END SUBROUTINE divgrad2_loc
Note: See TracBrowser for help on using the repository browser.