source: LMDZ5/branches/LMDZ5-DOFOCO/libf/dyn3dmem/gradiv2_loc.F @ 5160

Last change on this file since 5160 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.8 KB
Line 
1      SUBROUTINE gradiv2_loc(klevel, xcov, ycov, ld, gdx_out, gdy_out )
2c
3c     P. Le Van
4c
5c   **********************************************************
6c                                ld
7c       calcul  de  (grad (div) )   du vect. v ....
8c
9c     xcov et ycov etant les composant.covariantes de v
10c   **********************************************************
11c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
12c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
13c
14c
15      USE parallel
16      USE times
17      USE Write_field_p
18      USE mod_hallo
19      USE mod_filtreg_p
20      USE gradiv2_mod
21      IMPLICIT NONE
22c
23#include "dimensions.h"
24#include "paramet.h"
25#include "comgeom.h"
26#include "comdissipn.h"
27c
28c     ........    variables en arguments      ........
29
30      INTEGER klevel
31      REAL  xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )
32      REAL gdx_out( ijb_u:ije_u,klevel ), gdy_out( ijb_v:ije_v,klevel)
33c
34c     ........       variables locales       .........
35c
36      REAL      :: tmp_div2(ijb_u:ije_u,llm)
37      REAL signe, nugrads
38      INTEGER l,ij,iter,ld
39      INTEGER :: ijb,ije,jjb,jje
40      Type(Request)  :: request_dissip
41     
42c    ........................................................
43c
44c
45c      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
46c      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
47     
48      ijb=ij_begin
49      ije=ij_end
50     
51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
52      DO   l = 1, klevel
53        gdx(ijb:ije,l)=xcov(ijb:ije,l)
54      ENDDO
55c$OMP END DO NOWAIT     
56     
57      ijb=ij_begin
58      ije=ij_end
59      if(pole_sud) ije=ij_end-iip1
60
61c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
62      DO   l = 1, klevel
63        gdy(ijb:ije,l)=ycov(ijb:ije,l)
64      ENDDO
65c$OMP END DO NOWAIT
66
67c$OMP BARRIER
68       call Register_Hallo_v(gdy,llm,1,0,0,1,Request_dissip)
69       call SendRequest(Request_dissip)
70c$OMP BARRIER
71       call WaitRequest(Request_dissip)
72c$OMP BARRIER
73c
74c
75      signe   = (-1.)**ld
76      nugrads = signe * cdivu
77c
78
79
80      CALL    divergf_loc( klevel, gdx,   gdy , div )
81c      call write_field3d_p('div1',reshape(div,(/iip1,jjp1,llm/)))
82
83      IF( ld.GT.1 )   THEN
84c$OMP BARRIER
85       call Register_Hallo_u(div,llm,1,1,1,1,Request_dissip)
86       call SendRequest(Request_dissip)
87c$OMP BARRIER
88       call WaitRequest(Request_dissip)
89c$OMP BARRIER
90        CALL laplacien_loc( klevel, div,  div     )
91
92c    ......  Iteration de l'operateur laplacien_gam   .......
93c         call write_field3d_p('div2',reshape(div,(/iip1,jjp1,llm/)))
94
95        DO iter = 1, ld -2
96c$OMP BARRIER
97       call Register_Hallo_u(div,llm,1,1,1,1,Request_dissip)
98       call SendRequest(Request_dissip)
99c$OMP BARRIER
100       call WaitRequest(Request_dissip)
101
102c$OMP BARRIER
103
104         CALL laplacien_gam_loc(klevel,cuvscvgam1,cvuscugam1,
105     &                          unsair_gam1,unsapolnga1, unsapolsga1,
106     &                          div, div       )
107        ENDDO
108c        call write_field3d_p('div3',reshape(div,(/iip1,jjp1,llm/)))
109      ENDIF
110
111       jjb=jj_begin
112       jje=jj_end
113       
114       CALL filtreg_p( div   ,jjb_u,jje_u,jjb,jje, jjp1,
115     &                 klevel, 2, 1, .TRUE., 1 )
116c       call exchange_Hallo(div,ip1jmp1,llm,0,1)
117c$OMP BARRIER
118       call Register_Hallo_u(div,llm,1,1,1,1,Request_dissip)
119       call SendRequest(Request_dissip)
120c$OMP BARRIER
121       call WaitRequest(Request_dissip)
122
123c$OMP BARRIER
124
125
126       CALL  grad_loc( klevel,  div,   gdx,  gdy )
127
128c
129      ijb=ij_begin
130      ije=ij_end
131         
132c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
133       DO   l = 1, klevel
134         
135         if (pole_sud) ije=ij_end
136         DO  ij = ijb, ije
137          gdx_out( ij,l ) = gdx( ij,l ) * nugrads
138         ENDDO
139         
140         if (pole_sud) ije=ij_end-iip1
141         DO  ij = ijb, ije
142          gdy_out( ij,l ) = gdy( ij,l ) * nugrads
143         ENDDO
144       
145       ENDDO
146c$OMP END DO NOWAIT
147c
148       RETURN
149       END
Note: See TracBrowser for help on using the repository browser.