1 | SUBROUTINE gradiv2_loc(klevel, xcov, ycov, ld, gdx_out, gdy_out ) |
---|
2 | ! |
---|
3 | ! P. Le Van |
---|
4 | ! |
---|
5 | ! ********************************************************** |
---|
6 | ! ld |
---|
7 | ! calcul de (grad (div) ) du vect. v .... |
---|
8 | ! |
---|
9 | ! xcov et ycov etant les composant.covariantes de v |
---|
10 | ! ********************************************************** |
---|
11 | ! xcont , ycont et ld sont des arguments d'entree pour le s-prog |
---|
12 | ! gdx et gdy sont des arguments de sortie pour le s-prog |
---|
13 | ! |
---|
14 | ! |
---|
15 | USE comgeom_mod_h |
---|
16 | USE comdissipn_mod_h |
---|
17 | USE parallel_lmdz |
---|
18 | USE times |
---|
19 | USE Write_field_p |
---|
20 | USE mod_hallo |
---|
21 | USE mod_filtreg_p |
---|
22 | USE gradiv2_mod |
---|
23 | USE dimensions_mod, ONLY: iim, jjm, llm, ndm |
---|
24 | USE paramet_mod_h |
---|
25 | IMPLICIT NONE |
---|
26 | ! |
---|
27 | |
---|
28 | |
---|
29 | ! |
---|
30 | ! ........ variables en arguments ........ |
---|
31 | |
---|
32 | INTEGER :: klevel |
---|
33 | REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel ) |
---|
34 | REAL :: gdx_out( ijb_u:ije_u,klevel ), gdy_out( ijb_v:ije_v,klevel) |
---|
35 | ! |
---|
36 | ! ........ variables locales ......... |
---|
37 | ! |
---|
38 | REAL :: tmp_div2(ijb_u:ije_u,llm) |
---|
39 | REAL :: signe, nugrads |
---|
40 | INTEGER :: l,ij,iter,ld |
---|
41 | INTEGER :: ijb,ije,jjb,jje |
---|
42 | Type(Request),SAVE :: request_dissip |
---|
43 | !$OMP THREADPRIVATE(request_dissip) |
---|
44 | ! ........................................................ |
---|
45 | ! |
---|
46 | ! |
---|
47 | ! CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 ) |
---|
48 | ! CALL SCOPY( ip1jm * klevel, ycov, 1, gdy, 1 ) |
---|
49 | |
---|
50 | ijb=ij_begin |
---|
51 | ije=ij_end |
---|
52 | |
---|
53 | !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) |
---|
54 | DO l = 1, klevel |
---|
55 | gdx(ijb:ije,l)=xcov(ijb:ije,l) |
---|
56 | ENDDO |
---|
57 | !$OMP END DO NOWAIT |
---|
58 | |
---|
59 | ijb=ij_begin |
---|
60 | ije=ij_end |
---|
61 | if(pole_sud) ije=ij_end-iip1 |
---|
62 | |
---|
63 | !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) |
---|
64 | DO l = 1, klevel |
---|
65 | gdy(ijb:ije,l)=ycov(ijb:ije,l) |
---|
66 | ENDDO |
---|
67 | !$OMP END DO NOWAIT |
---|
68 | |
---|
69 | !$OMP BARRIER |
---|
70 | call Register_Hallo_v(gdy,llm,1,0,0,1,Request_dissip) |
---|
71 | call SendRequest(Request_dissip) |
---|
72 | !$OMP BARRIER |
---|
73 | call WaitRequest(Request_dissip) |
---|
74 | !$OMP BARRIER |
---|
75 | ! |
---|
76 | ! |
---|
77 | signe = (-1.)**ld |
---|
78 | nugrads = signe * cdivu |
---|
79 | ! |
---|
80 | |
---|
81 | |
---|
82 | CALL divergf_loc( klevel, gdx, gdy , div ) |
---|
83 | ! call write_field3d_p('div1',reshape(div,(/iip1,jjp1,llm/))) |
---|
84 | |
---|
85 | IF( ld.GT.1 ) THEN |
---|
86 | !$OMP BARRIER |
---|
87 | call Register_Hallo_u(div,llm,1,1,1,1,Request_dissip) |
---|
88 | call SendRequest(Request_dissip) |
---|
89 | !$OMP BARRIER |
---|
90 | call WaitRequest(Request_dissip) |
---|
91 | !$OMP BARRIER |
---|
92 | CALL laplacien_loc( klevel, div, div ) |
---|
93 | |
---|
94 | ! ...... Iteration de l'operateur laplacien_gam ....... |
---|
95 | ! call write_field3d_p('div2',reshape(div,(/iip1,jjp1,llm/))) |
---|
96 | |
---|
97 | DO iter = 1, ld -2 |
---|
98 | !$OMP BARRIER |
---|
99 | call Register_Hallo_u(div,llm,1,1,1,1,Request_dissip) |
---|
100 | call SendRequest(Request_dissip) |
---|
101 | !$OMP BARRIER |
---|
102 | call WaitRequest(Request_dissip) |
---|
103 | |
---|
104 | !$OMP BARRIER |
---|
105 | |
---|
106 | CALL laplacien_gam_loc(klevel,cuvscvgam1,cvuscugam1, & |
---|
107 | unsair_gam1,unsapolnga1, unsapolsga1, & |
---|
108 | div, div ) |
---|
109 | ENDDO |
---|
110 | ! call write_field3d_p('div3',reshape(div,(/iip1,jjp1,llm/))) |
---|
111 | ENDIF |
---|
112 | |
---|
113 | jjb=jj_begin |
---|
114 | jje=jj_end |
---|
115 | |
---|
116 | CALL filtreg_p( div ,jjb_u,jje_u,jjb,jje, jjp1, & |
---|
117 | klevel, 2, 1, .TRUE., 1 ) |
---|
118 | ! call exchange_Hallo(div,ip1jmp1,llm,0,1) |
---|
119 | !$OMP BARRIER |
---|
120 | call Register_Hallo_u(div,llm,1,1,1,1,Request_dissip) |
---|
121 | call SendRequest(Request_dissip) |
---|
122 | !$OMP BARRIER |
---|
123 | call WaitRequest(Request_dissip) |
---|
124 | |
---|
125 | !$OMP BARRIER |
---|
126 | |
---|
127 | |
---|
128 | CALL grad_loc( klevel, div, gdx, gdy ) |
---|
129 | |
---|
130 | ! |
---|
131 | ijb=ij_begin |
---|
132 | ije=ij_end |
---|
133 | |
---|
134 | !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) |
---|
135 | DO l = 1, klevel |
---|
136 | |
---|
137 | if (pole_sud) ije=ij_end |
---|
138 | DO ij = ijb, ije |
---|
139 | gdx_out( ij,l ) = gdx( ij,l ) * nugrads |
---|
140 | ENDDO |
---|
141 | |
---|
142 | if (pole_sud) ije=ij_end-iip1 |
---|
143 | DO ij = ijb, ije |
---|
144 | gdy_out( ij,l ) = gdy( ij,l ) * nugrads |
---|
145 | ENDDO |
---|
146 | |
---|
147 | ENDDO |
---|
148 | !$OMP END DO NOWAIT |
---|
149 | ! |
---|
150 | RETURN |
---|
151 | END SUBROUTINE gradiv2_loc |
---|