source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divgrad2_loc.f90 @ 5153

Last change on this file since 5153 was 5136, checked in by abarral, 8 weeks ago

Put comgeom.h, comgeom2.h into modules

  • 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.0 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 lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
17  USE lmdz_comgeom2
18
19  IMPLICIT NONE
20  !
21  INCLUDE "dimensions.h"
22  INCLUDE "paramet.h"
23
24  !    .......    variables en arguments   .......
25  !
26  INTEGER :: klevel
27  REAL :: h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel )
28  REAL :: divgra_out( ijb_u:ije_u,klevel)
29  !    .......    variables  locales    ..........
30  !
31  REAL :: signe, nudivgrs, sqrtps( ijb_u:ije_u,llm )
32  INTEGER :: l,ij,iter,lh
33  !    ...................................................................
34  Type(Request),SAVE :: request_dissip
35!$OMP THREADPRIVATE(request_dissip)
36  INTEGER :: ijb,ije
37
38  !
39  !
40  signe    = (-1.)**lh
41  nudivgrs = signe * cdivh
42
43   ! CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
44  ijb=ij_begin
45  ije=ij_end
46!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
47  DO l = 1, klevel
48    divgra(ijb:ije,l)=h(ijb:ije,l)
49  ENDDO
50!$OMP END DO NOWAIT
51  !
52!$OMP BARRIER
53   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
54   CALL SendRequest(Request_dissip)
55!$OMP BARRIER
56   CALL WaitRequest(Request_dissip)
57!$OMP BARRIER
58
59  CALL laplacien_loc( klevel, divgra, divgra )
60
61!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
62  DO l = 1, klevel
63   DO ij = ijb, ije
64    sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
65   ENDDO
66  ENDDO
67!$OMP END DO NOWAIT
68
69  !
70!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
71  DO l = 1, klevel
72    DO ij = ijb, ije
73     divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
74    ENDDO
75  ENDDO
76!$OMP END DO NOWAIT
77
78  !    ........    Iteration de l'operateur  laplacien_gam    ........
79  !
80  DO  iter = 1, lh - 2
81!$OMP BARRIER
82   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
83   CALL SendRequest(Request_dissip)
84!$OMP BARRIER
85   CALL WaitRequest(Request_dissip)
86
87!$OMP BARRIER
88
89
90   CALL laplacien_gam_loc(klevel,cuvscvgam2,cvuscugam2,unsair_gam2, &
91         unsapolnga2, unsapolsga2,  divgra, divgra )
92  ENDDO
93  !
94  !    ...............................................................
95
96!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
97  DO l = 1, klevel
98    DO ij = ijb, ije
99      divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
100    ENDDO
101  ENDDO
102!$OMP END DO NOWAIT
103  !
104!$OMP BARRIER
105   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
106   CALL SendRequest(Request_dissip)
107!$OMP BARRIER
108   CALL WaitRequest(Request_dissip)
109!$OMP BARRIER
110
111  CALL laplacien_loc ( klevel, divgra, divgra )
112  !
113!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
114  DO l  = 1,klevel
115  DO ij = ijb,ije
116  divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
117  ENDDO
118  ENDDO
119!$OMP END DO NOWAIT
120
121
122END SUBROUTINE divgrad2_loc
Note: See TracBrowser for help on using the repository browser.