My Project
 All Classes Files Functions Variables Macros
divgrad2_p.F
Go to the documentation of this file.
1  SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out )
2 c
3 c P. Le Van
4 c
5 c ***************************************************************
6 c
7 c ..... calcul de (div( grad )) de ( pext * h ) .....
8 c ****************************************************************
9 c h ,klevel,lh et pext sont des arguments d'entree pour le s-prg
10 c divgra est un argument de sortie pour le s-prg
11 c
12  USE parallel
13  USE times
14  USE mod_hallo
15  IMPLICIT NONE
16 c
17 #include "dimensions.h"
18 #include "paramet.h"
19 #include "comgeom2.h"
20 #include "comdissipn.h"
21 
22 c ....... variables en arguments .......
23 c
24  INTEGER klevel
25  REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
26  REAL divgra_out( ip1jmp1,klevel)
27  REAL,SAVE :: divgra( ip1jmp1,llm)
28 
29 c
30 c ....... variables locales ..........
31 c
32  REAL signe, nudivgrs, sqrtps( ip1jmp1,llm )
33  INTEGER l,ij,iter,lh
34 c ...................................................................
35  Type(request) :: request_dissip
36  INTEGER ijb,ije
37 c
38  signe = (-1.)**lh
39  nudivgrs = signe * cdivh
40 
41 c CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
42  ijb=ij_begin
43  ije=ij_end
44 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
45  DO l = 1, klevel
46  divgra(ijb:ije,l)=h(ijb:ije,l)
47  ENDDO
48 c$OMP END DO NOWAIT
49 c
50 c$OMP BARRIER
51  call register_hallo(divgra,ip1jmp1,llm,1,1,1,1,request_dissip)
52  call sendrequest(request_dissip)
53 c$OMP BARRIER
54  call waitrequest(request_dissip)
55 c$OMP BARRIER
56 
57  CALL laplacien_p( klevel, divgra, divgra )
58 
59 c$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
65 c$OMP END DO NOWAIT
66 
67 c
68 c$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
74 c$OMP END DO NOWAIT
75 
76 c ........ Iteration de l'operateur laplacien_gam ........
77 c
78  DO iter = 1, lh - 2
79 c$OMP BARRIER
80  call register_hallo(divgra,ip1jmp1,llm,1,1,1,1,request_dissip)
81  call sendrequest(request_dissip)
82 c$OMP BARRIER
83  call waitrequest(request_dissip)
84 
85 c$OMP BARRIER
86 
87 
88  CALL laplacien_gam_p( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
89  * unsapolnga2, unsapolsga2, divgra, divgra )
90  ENDDO
91 c
92 c ...............................................................
93 
94 c$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
100 c$OMP END DO NOWAIT
101 c
102 c$OMP BARRIER
103  call register_hallo(divgra,ip1jmp1,llm,1,1,1,1,request_dissip)
104  call sendrequest(request_dissip)
105 c$OMP BARRIER
106  call waitrequest(request_dissip)
107 c$OMP BARRIER
108 
109  CALL laplacien_p( klevel, divgra, divgra )
110 c
111 c$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
117 c$OMP END DO NOWAIT
118 
119  RETURN
120  END