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