1 | SUBROUTINE divgrad2_loc ( 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_lmdz |
---|
13 | USE times |
---|
14 | USE mod_hallo |
---|
15 | USE divgrad2_mod |
---|
16 | IMPLICIT NONE |
---|
17 | c |
---|
18 | #include "dimensions.h" |
---|
19 | #include "paramet.h" |
---|
20 | #include "comgeom2.h" |
---|
21 | #include "comdissipn.h" |
---|
22 | |
---|
23 | c ....... variables en arguments ....... |
---|
24 | c |
---|
25 | INTEGER klevel |
---|
26 | REAL h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel ) |
---|
27 | REAL divgra_out( ijb_u:ije_u,klevel) |
---|
28 | c ....... variables locales .......... |
---|
29 | c |
---|
30 | REAL signe, nudivgrs, sqrtps( ijb_u:ije_u,llm ) |
---|
31 | INTEGER l,ij,iter,lh |
---|
32 | c ................................................................... |
---|
33 | Type(Request) :: request_dissip |
---|
34 | INTEGER ijb,ije |
---|
35 | |
---|
36 | c |
---|
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_u(divgra,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_loc( 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_u(divgra,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_loc(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_u(divgra,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_loc ( 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 |
---|