source: LMDZ5/trunk/libf/dyn3dmem/nxgrarot_p.F @ 1783

Last change on this file since 1783 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: 2.6 KB
RevLine 
[1632]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
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"
24#include "logic.h"
25c
26      INTEGER klevel
27      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
28      REAL  grx_out( ip1jmp1,klevel ),  gry_out( ip1jm,klevel )
29      REAL,SAVE ::  grx( ip1jmp1,llm ),  gry( ip1jm,llm )
30
31c
32      REAL,SAVE :: rot(ip1jm,llm)
33
34      INTEGER l,ij,iter,lr
35c
36      INTEGER ijb,ije,jjb,jje
37c
38c
39c      CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
40c      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
41c
42      ijb=ij_begin
43      ije=ij_end
44c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
45      DO l = 1, klevel
46        grx(ijb:ije,l)=xcov(ijb:ije,l)
47      ENDDO
48c$OMP END DO NOWAIT     
49
50      if(pole_sud) ije=ij_end-iip1
51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
52      DO l = 1, klevel
53        gry(ijb:ije,l)=ycov(ijb:ije,l)
54      ENDDO
55c$OMP END DO NOWAIT
56     
57      DO 10 iter = 1,lr
58c$OMP BARRIER
59c$OMP MASTER
60      call suspend_timer(timer_dissip)
61      call exchange_Hallo(grx,ip1jmp1,llm,0,1)
62      call resume_timer(timer_dissip)
63c$OMP END MASTER
64c$OMP BARRIER
65
66      CALL  rotat_p (klevel,grx, gry, rot )
67c      call write_field3d_p('rot',reshape(rot,(/iip1,jjm,llm/)))
68     
69      jjb=jj_begin
70      jje=jj_end
71      if (pole_sud) jje=jj_end-1
72      CALL filtreg_p( rot,jjb,jje, jjm, klevel, 2,1, .false.,2)
73
74c$OMP BARRIER
75c$OMP MASTER
76      call suspend_timer(timer_dissip)
77      call exchange_Hallo(rot,ip1jm,llm,1,0)
78      call resume_timer(timer_dissip)
79c$OMP END MASTER
80c$OMP BARRIER
81     
82      CALL nxgrad_p (klevel,rot, grx, gry )
83c
84c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
85      DO 5  l = 1, klevel
86      if(pole_sud) ije=ij_end-iip1
87      DO 2 ij = ijb, ije
88      gry_out( ij,l ) = - gry( ij,l ) * crot
89   2  CONTINUE
90      if(pole_sud) ije=ij_end
91      DO 3 ij = ijb, ije
92      grx_out( ij,l ) = - grx( ij,l ) * crot
93   3  CONTINUE
94   5  CONTINUE
95c$OMP END DO NOWAIT
96c      call write_field3d_p('grx',reshape(grx,(/iip1,jjp1,llm/)))
97c      call write_field3d_p('gry',reshape(gry,(/iip1,jjm,llm/)))
98c      stop
99  10  CONTINUE
100      RETURN
101      END
Note: See TracBrowser for help on using the repository browser.