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