source: trunk/LMDZ.COMMON/libf/dyn3dpar/nxgraro2_p.F

Last change on this file was 1019, checked in by emillour, 11 years ago

Common dynamics; keep up with updates (seq and ) in LMDZ5 (up tio rev 1845):

  • General stuff:
  • makelmdz_fcm: add options -j # (compile using # threads) and -full, and to keep up

with Earth model, possibility to compile with various versions of orchidee

  • bld.cfg: adaptations to enable compiling using multiple threads
  • build_gcm: adaptations to enable compiling using multiple threads
  • makelmdz: keep up with Earth model: possibility to compile with various versions of orchidee + cosmetic changes + library directory name change
  • bibio:
  • wxios.F90 : Added for possible future use of XIOS library
  • filtrez:
  • mkl_dft_type.f90 & mkl_dfti.f90 : MKL (for MKL FFT) interface definitions
  • filtreg_mod : limit use of FFT to parallel mode
  • mod_filtre_fft.F90 & mod_filtre_fft_lov.F90 : swich to use parallel_lmdz
  • dyn3d:
  • abort_gcm.F : add things for xios
  • advtrac.F90 : minor change in CFL outputs
  • ce0l.F90 : indicesol.h is now module indice_sol_mod
  • comvert.h : cosmetic change on comments
  • gcm.F : add xios and use module indice_sol_mod (for INCA)
  • inigeom.F : move two computations outside loop
  • dyn3dpar:
  • parallel.F90 => parallel_lmdz.F90 : and change all the "use parallel" into "use parallel_lmdz" in all files in dyn3dpar
  • comvert.h : cosmetic change on comments
  • gcm.F : add xios and use module indice_sol_mod (for INCA)
  • leapfrog_p.F : add xios + correction for times in Newtonian case
  • ce0l.F90 : indicesol.h is now module indice_sol_mod
  • inigeom.F : move two computations outside loop

EM
File size: 3.6 KB
RevLine 
[1]1       SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx_out, gry_out )
2c
3c      P.Le Van .
4c   ***********************************************************
5c                                 lr
6c      calcul de  ( nxgrad (rot) )   du vect. v  ....
7c
8c       xcov et ycov  etant les compos. covariantes de  v
9c   ***********************************************************
10c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
11c      grx   et  gry     sont des arguments de sortie pour le s-prog
12c
13c
14      USE write_Field_p
[1019]15      USE parallel_lmdz
[1]16      USE times
17      USE mod_hallo
18      IMPLICIT NONE
19c
20#include "dimensions.h"
21#include "paramet.h"
22#include "comdissipn.h"
23c
24c    ......  variables en arguments  .......
25c
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 )
30c
31c    ......   variables locales     ........
32c
33      REAL,SAVE :: rot(ip1jm,llm)
34      REAL  signe, nugradrs
35      INTEGER l,ij,iter,lr
36      Type(Request) :: Request_dissip
37c    ........................................................
38c
39      INTEGER :: ijb,ije,jjb,jje
40     
41c
42c
43      signe    = (-1.)**lr
44      nugradrs = signe * crot
45c
46c      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
47c      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
48 
49      ijb=ij_begin
50      ije=ij_end
51
52c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
53      DO    l = 1, klevel
54        grx(ijb:ije,l)=xcov(ijb:ije,l)
55      ENDDO
56c$OMP END DO NOWAIT
57
58c$OMP BARRIER
59       call Register_Hallo(grx,ip1jmp1,llm,0,1,1,0,Request_dissip)
60       call SendRequest(Request_dissip)
61c$OMP BARRIER
62       call WaitRequest(Request_dissip)
63c$OMP BARRIER
64
65      ijb=ij_begin
66      ije=ij_end
67      if(pole_sud) ije=ij_end-iip1
68
69c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
70      DO    l = 1, klevel
71        gry(ijb:ije,l)=ycov(ijb:ije,l)
72      ENDDO
73c$OMP END DO NOWAIT
74 
75c
76      CALL     rotatf_p     ( klevel, grx, gry, rot )
77c      call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
78
79c$OMP BARRIER
80       call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
81       call SendRequest(Request_dissip)
82c$OMP BARRIER
83       call WaitRequest(Request_dissip)
84c$OMP BARRIER
85     
86      CALL laplacien_rot_p ( klevel, rot, rot,grx,gry      )
87c       call write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))
88c
89c    .....   Iteration de l'operateur laplacien_rotgam  .....
90c
91      DO  iter = 1, lr -2
92c$OMP BARRIER
93       call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
94       call SendRequest(Request_dissip)
95c$OMP BARRIER
96       call WaitRequest(Request_dissip)
97c$OMP BARRIER
98
99        CALL laplacien_rotgam_p ( klevel, rot, rot )
100      ENDDO
101     
102c       call write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))
103     
104c
105c
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)
111c$OMP BARRIER
112       call Register_Hallo(rot,ip1jm,llm,1,0,0,1,Request_dissip)
113       call SendRequest(Request_dissip)
114c$OMP BARRIER
115       call WaitRequest(Request_dissip)
116c$OMP BARRIER
117
118      CALL nxgrad_p ( klevel, rot, grx, gry )
119
120c
121      ijb=ij_begin
122      ije=ij_end
123     
124c$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
138c$OMP END DO NOWAIT
139c
140      RETURN
141      END
Note: See TracBrowser for help on using the repository browser.