source: LMDZ5/trunk/libf/dyn3dmem/divgrad_p.F @ 1721

Last change on this file since 1721 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.1 KB
RevLine 
[1632]1      SUBROUTINE divgrad_p (klevel,h, lh, divgra_out )
2      USE parallel
3      USE times
4      IMPLICIT NONE
5c
6c=======================================================================
7c
8c  Auteur :   P. Le Van
9c  ----------
10c
11c                              lh
12c      calcul de  (div( grad ))   de h  .....
13c      h  et lh  sont des arguments  d'entree pour le s-prog
14c      divgra     est  un argument  de sortie pour le s-prog
15c
16c=======================================================================
17c
18c   declarations:
19c   -------------
20c
21#include "dimensions.h"
22#include "paramet.h"
23#include "comgeom.h"
24#include "comdissipn.h"
25#include "logic.h"
26c
27      INTEGER klevel
28      REAL h( ip1jmp1,klevel ), divgra_out( ip1jmp1,klevel )
29      REAL,SAVE :: divgra( ip1jmp1,llm )
30
31c
32      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
33
34      INTEGER  l,ij,iter,lh
35c
36      INTEGER ijb,ije,jjb,jje
37c
38c
39c      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
40     
41      ijb=ij_begin
42      ije=ij_end
43c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
44      DO l = 1, klevel     
45      divgra(ijb:ije,l)=h(ijb:ije,l)
46      ENDDO
47c$OMP END DO NOWAIT
48c
49
50c
51      DO 10 iter = 1,lh
52
53      jjb=jj_begin
54      jje=jj_end
55      CALL filtreg_p ( divgra,jjb,jje,jjp1,klevel,2,1,.true.,1  )
56
57c      call exchange_Hallo(divgra,ip1jmp1,llm,0,1)
58c$OMP BARRIER
59c$OMP MASTER     
60      call suspend_timer(timer_dissip)
61      call exchange_Hallo(divgra,ip1jmp1,llm,1,1)
62      call resume_timer(timer_dissip)
63c$OMP END MASTER
64c$OMP BARRIER       
65      CALL    grad_p (klevel,divgra, ghx  , ghy          )
66
67c$OMP BARRIER
68c$OMP MASTER   
69      call suspend_timer(timer_dissip)
70      call exchange_Hallo(ghy,ip1jm,llm,1,0)
71      call resume_timer(timer_dissip)
72c$OMP END MASTER
73c$OMP BARRIER           
74
75      CALL  diverg_p (klevel,  ghx , ghy  , divgra       )
76
77      jjb=jj_begin
78      jje=jj_end
79      CALL filtreg_p( divgra,jjb,jje,jjp1,klevel,2,1,.true.,1)
80
81c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
82      DO 5 l = 1,klevel
83      DO 4  ij = ijb, ije
84      divgra_out( ij,l ) = - cdivh * divgra( ij,l )
85   4  CONTINUE
86   5  CONTINUE
87c$OMP END DO NOWAIT
88c
89  10  CONTINUE
90      RETURN
91      END
Note: See TracBrowser for help on using the repository browser.