source: LMDZ6/branches/DYNAMICO-conv/libf/dyn3dpar/nxgrarot_p.F @ 3024

Last change on this file since 3024 was 2603, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn logic.h into module logic_mod.F90
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.6 KB
Line 
1      SUBROUTINE nxgrarot_p (klevel,xcov, ycov, lr, grx_out, gry_out )
2c   ***********************************************************
3c
4c    Auteur :  P.Le Van 
5c
6c                                 lr
7c      calcul de  ( nXgrad (rot) )   du vect. v  ....
8c
9c       xcov et ycov  etant les compos. covariantes de  v
10c   ***********************************************************
11c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
12c      grx   et  gry     sont des arguments de sortie pour le s-prog
13c
14c
15      USE parallel_lmdz
16      USE times
17      USE write_field_p
18      IMPLICIT NONE
19c
20c
21#include "dimensions.h"
22#include "paramet.h"
23#include "comdissipn.h"
24c
25      INTEGER klevel
26      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
27      REAL  grx_out( ip1jmp1,klevel ),  gry_out( ip1jm,klevel )
28      REAL,SAVE ::  grx( ip1jmp1,llm ),  gry( ip1jm,llm )
29
30c
31      REAL,SAVE :: rot(ip1jm,llm)
32
33      INTEGER l,ij,iter,lr
34c
35      INTEGER ijb,ije,jjb,jje
36c
37c
38c      CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
39c      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
40c
41      ijb=ij_begin
42      ije=ij_end
43c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
44      DO l = 1, klevel
45        grx(ijb:ije,l)=xcov(ijb:ije,l)
46      ENDDO
47c$OMP END DO NOWAIT     
48
49      if(pole_sud) ije=ij_end-iip1
50c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
51      DO l = 1, klevel
52        gry(ijb:ije,l)=ycov(ijb:ije,l)
53      ENDDO
54c$OMP END DO NOWAIT
55     
56      DO 10 iter = 1,lr
57c$OMP BARRIER
58c$OMP MASTER
59      call suspend_timer(timer_dissip)
60      call exchange_Hallo(grx,ip1jmp1,llm,0,1)
61      call resume_timer(timer_dissip)
62c$OMP END MASTER
63c$OMP BARRIER
64
65      CALL  rotat_p (klevel,grx, gry, rot )
66c      call write_field3d_p('rot',reshape(rot,(/iip1,jjm,llm/)))
67     
68      jjb=jj_begin
69      jje=jj_end
70      if (pole_sud) jje=jj_end-1
71      CALL filtreg_p( rot,jjb,jje, jjm, klevel, 2,1, .false.,2)
72
73c$OMP BARRIER
74c$OMP MASTER
75      call suspend_timer(timer_dissip)
76      call exchange_Hallo(rot,ip1jm,llm,1,0)
77      call resume_timer(timer_dissip)
78c$OMP END MASTER
79c$OMP BARRIER
80     
81      CALL nxgrad_p (klevel,rot, grx, gry )
82c
83c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
84      DO 5  l = 1, klevel
85      if(pole_sud) ije=ij_end-iip1
86      DO 2 ij = ijb, ije
87      gry_out( ij,l ) = - gry( ij,l ) * crot
88   2  CONTINUE
89      if(pole_sud) ije=ij_end
90      DO 3 ij = ijb, ije
91      grx_out( ij,l ) = - grx( ij,l ) * crot
92   3  CONTINUE
93   5  CONTINUE
94c$OMP END DO NOWAIT
95c      call write_field3d_p('grx',reshape(grx,(/iip1,jjp1,llm/)))
96c      call write_field3d_p('gry',reshape(gry,(/iip1,jjm,llm/)))
97c      stop
98  10  CONTINUE
99      RETURN
100      END
Note: See TracBrowser for help on using the repository browser.