My Project
 All Classes Files Functions Variables Macros
nxgraro2_loc.F
Go to the documentation of this file.
1  SUBROUTINE nxgraro2_loc(klevel,xcov,ycov,lr,grx_out,gry_out)
2 c
3 c p.le van .
4 c ***********************************************************
5 c lr
6 c calcul de( nxgrad(rot) ) du vect. v ....
7 c
8 c xcov et ycov etant les compos. covariantes de v
9 c ***********************************************************
10 c xcov , ycov et lr sont des arguments d
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 'entree pour le s-progc grx et gry sont des arguments de sortie pour le s-progcc USE write_Field_p USE parallel USE times USE mod_hallo USE mod_filtreg_p USE nxgraro2_mod IMPLICIT NONEc#include "dimensions.h"#include "paramet.h"#include "comdissipn.h"cc ...... variables en arguments .......c INTEGER klevel REAL xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel ) REAL grx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel)cc ...... variables locales ........c REAL signe, nugradrs INTEGER l,ij,iter,lr Type(Request) :: Request_dissipc ........................................................c INTEGER :: ijb,ije,jjb,jje cc signe = (-1.)**lr nugradrs = signe * crotcc CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )c CALL SCOPY ( ip1jm * klevel, ycov, 1, gry, 1 ) ijb=ij_begin ije=ij_endc$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, klevel grx(ijb:ije,l)=xcov(ijb:ije,l) ENDDOc$OMP END DO NOWAITc$OMP BARRIER call Register_Hallo_u(grx,llm,0,1,1,0,Request_dissip) call SendRequest(Request_dissip)c$OMP BARRIER call WaitRequest(Request_dissip)c$OMP BARRIER ijb=ij_begin ije=ij_end if(pole_sud) ije=ij_end-iip1c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, klevel gry(ijb:ije,l)=ycov(ijb:ije,l) ENDDOc$OMP END DO NOWAIT c CALL rotatf_loc ( klevel, grx, gry, rot )c call write_field3d_p('rot1
78 
79 
80 
81 
82 
83 
84 
85 
86 
87 ',reshape(rot,(/iip1,jjm,llm/)))c$OMP BARRIER call Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip) call SendRequest(Request_dissip)c$OMP BARRIER call WaitRequest(Request_dissip)c$OMP BARRIER CALL laplacien_rot_loc ( klevel, rot, rot,grx,gry )c call write_field3d_p('rot2
88 
89 ',reshape(rot,(/iip1,jjm,llm/)))cc ..... Iteration de l'operateur laplacien_rotgam .....
90 c
91  DO iter = 1, lr -2
92 c$omp barrier
93  call register_hallo_v(rot,llm,1,1,1,1,request_dissip)
94  call sendrequest(request_dissip)
95 c$omp barrier
96  call waitrequest(request_dissip)
97 c$omp barrier
98 
99  CALL laplacien_rotgam_loc( klevel, rot, rot )
100  ENDDO
101 
102 c call write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))
103 
104 c
105 c
106  jjb=jj_begin
107  jje=jj_end
108  if (pole_sud) jje=jj_end-1
109 
110  CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm,
111  & klevel, 2,1, .false.,1)
112 c$omp barrier
113  call register_hallo_v(rot,llm,1,0,0,1,request_dissip)
114  call sendrequest(request_dissip)
115 c$omp barrier
116  call waitrequest(request_dissip)
117 c$omp barrier
118 
119  CALL nxgrad_loc( klevel, rot, grx, gry )
120 
121 c
122  ijb=ij_begin
123  ije=ij_end
124 
125 c$omp DO schedule(static,omp_chunk)
126  DO l = 1, klevel
127 
128  if(pole_sud) ije=ij_end-iip1
129  DO ij = ijb, ije
130  gry_out( ij,l ) = gry( ij,l ) * nugradrs
131  ENDDO
132 
133  if(pole_sud) ije=ij_end
134  DO ij = ijb, ije
135  grx_out( ij,l ) = grx( ij,l ) * nugradrs
136  ENDDO
137 
138  ENDDO
139 c$omp END DO nowait
140 c
141  RETURN
142  END