LMDZ
nxgraro2_p.F
Go to the documentation of this file.
1  SUBROUTINE nxgraro2_p (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'entree pour le s-prog
11 c grx et gry sont des arguments de sortie pour le s-prog
12 c
13 c
14  USE write_Field_p
15  USE parallel_lmdz
16  USE times
17  USE mod_hallo
18  IMPLICIT NONE
19 c
20 #include "dimensions.h"
21 #include "paramet.h"
22 #include "comdissipn.h"
23 c
24 c ...... variables en arguments .......
25 c
26  INTEGER klevel
27  REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
28  REAL,SAVE :: grx( ip1jmp1,llm ), gry( ip1jm,llm )
29  REAL grx_out( ip1jmp1,klevel ), gry_out( ip1jm,klevel )
30 c
31 c ...... variables locales ........
32 c
33  REAL,SAVE :: rot(ip1jm,llm)
34  REAL signe, nugradrs
35  INTEGER l,ij,iter,lr
36  Type(Request) :: Request_dissip
37 c ........................................................
38 c
39  INTEGER :: ijb,ije,jjb,jje
40 
41 c
42 c
43  signe = (-1.)**lr
44  nugradrs = signe * crot
45 c
46 c CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
47 c CALL SCOPY ( ip1jm * klevel, ycov, 1, gry, 1 )
48 
49  ijb=ij_begin
50  ije=ij_end
51 
52 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
53  DO l = 1, klevel
54  grx(ijb:ije,l)=xcov(ijb:ije,l)
55  ENDDO
56 c$OMP END DO NOWAIT
57 
58 c$OMP BARRIER
59  call Register_Hallo(grx,ip1jmp1,llm,0,1,1,0,Request_dissip)
60  call SendRequest(Request_dissip)
61 c$OMP BARRIER
62  call WaitRequest(Request_dissip)
63 c$OMP BARRIER
64 
65  ijb=ij_begin
66  ije=ij_end
67  if(pole_sud) ije=ij_end-iip1
68 
69 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
70  DO l = 1, klevel
71  gry(ijb:ije,l)=ycov(ijb:ije,l)
72  ENDDO
73 c$OMP END DO NOWAIT
74 
75 c
76  CALL rotatf_p ( klevel, grx, gry, rot )
77 c call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
78 
79 c$OMP BARRIER
80  call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
81  call SendRequest(Request_dissip)
82 c$OMP BARRIER
83  call WaitRequest(Request_dissip)
84 c$OMP BARRIER
85 
86  CALL laplacien_rot_p ( klevel, rot, rot,grx,gry )
87 c call write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))
88 c
89 c ..... Iteration de l'operateur laplacien_rotgam .....
90 c
91  DO iter = 1, lr -2
92 c$omp barrier
93  call register_hallo(rot,ip1jm,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_p ( 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,jje,jjm, klevel, 2,1, .false.,1)
111 c$omp barrier
112  call register_hallo(rot,ip1jm,llm,1,0,0,1,request_dissip)
113  call sendrequest(request_dissip)
114 c$omp barrier
115  call waitrequest(request_dissip)
116 c$omp barrier
117 
118  CALL nxgrad_p ( klevel, rot, grx, gry )
119 
120 c
121  ijb=ij_begin
122  ije=ij_end
123 
124 c$omp DO schedule(static,omp_chunk)
125  DO l = 1, klevel
126 
127  if(pole_sud) ije=ij_end-iip1
128  DO ij = ijb, ije
129  gry_out( ij,l ) = gry( ij,l ) * nugradrs
130  ENDDO
131 
132  if(pole_sud) ije=ij_end
133  DO ij = ijb, ije
134  grx_out( ij,l ) = grx( ij,l ) * nugradrs
135  ENDDO
136 
137  ENDDO
138 c$omp END DO nowait
139 c
140  RETURN
141  END
l
c c $Id c c calculs statistiques distribution nuage ftion du regime dynamique c c Ce calcul doit etre fait a partir de valeurs mensuelles CALL nbregdyn DO kmaxm1 DO l
Definition: calcul_REGDYN.h:13
filtreg_p
subroutine filtreg_p(champ, ibeg, iend, nlat, nbniv, ifiltre, iaire, griscal, iter)
Definition: filtreg_p.F:5
nxgrad
subroutine nxgrad(klevel, rot, x, y)
Definition: nxgrad.F:5
laplacien_rotgam
subroutine laplacien_rotgam(klevel, rotin, rotout)
Definition: laplacien_rotgam.F:5
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
nxgrad_p
subroutine nxgrad_p(klevel, rot, x, y)
Definition: nxgrad_p.F:2
ip1jm
!$Header llmm1 INTEGER ip1jm
Definition: paramet.h:14
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
ij
!$Id klon klev DO klon!IM klev DO klon klon nbp_lat DO nbp_lon ij
Definition: write_histday_seri.h:96
nxgraro2_p
subroutine nxgraro2_p(klevel, xcov, ycov, lr, grx_out, gry_out)
Definition: nxgraro2_p.F:2
laplacien_rotgam_p
subroutine laplacien_rotgam_p(klevel, rotin, rotout)
Definition: laplacien_rotgam_p.F:2
de
do llm!au dessus de
Definition: 1D_nudge_sandu_astex.h:1