source: LMDZ5/branches/LMDZ5-DOFOCO/libf/dyn3dmem/nxgraro2_loc.F @ 2265

Last change on this file since 2265 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT


Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 3.5 KB
Line 
1       SUBROUTINE nxgraro2_loc(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
15      USE parallel
16      USE times
17      USE mod_hallo
18      USE mod_filtreg_p
19      USE nxgraro2_mod
20      IMPLICIT NONE
21c
22#include "dimensions.h"
23#include "paramet.h"
24#include "comdissipn.h"
25c
26c    ......  variables en arguments  .......
27c
28      INTEGER klevel
29      REAL xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )
30      REAL  grx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel)
31c
32c    ......   variables locales     ........
33c
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_u(grx,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_loc ( klevel, grx, gry, rot )
77c      call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
78
79c$OMP BARRIER
80       call Register_Hallo_v(rot,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_loc ( 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_v(rot,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_loc( 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_v,jje_v, jjb,jje,jjm,
111     &                klevel, 2,1, .FALSE.,1)
112c$OMP BARRIER
113       call Register_Hallo_v(rot,llm,1,0,0,1,Request_dissip)
114       call SendRequest(Request_dissip)
115c$OMP BARRIER
116       call WaitRequest(Request_dissip)
117c$OMP BARRIER
118
119      CALL nxgrad_loc ( klevel, rot, grx, gry )
120
121c
122      ijb=ij_begin
123      ije=ij_end
124     
125c$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
139c$OMP END DO NOWAIT
140c
141      RETURN
142      END
Note: See TracBrowser for help on using the repository browser.