source: LMDZ5/trunk/libf/dyn3dmem/dteta1_loc.F @ 1720

Last change on this file since 1720 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.3 KB
Line 
1      SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta)
2      USE parallel
3      USE write_field_p
4      USE mod_filtreg_p
5      IMPLICIT NONE
6
7c=======================================================================
8c
9c   Auteur:  P. Le Van
10c   -------
11c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
12c
13c   ********************************************************************
14c   ... calcul du terme de convergence horizontale du flux d'enthalpie
15c        potentielle   ......
16c   ********************************************************************
17c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
18c     dteta               sont des arguments de sortie pour le s-pg ....
19c
20c=======================================================================
21
22
23#include "dimensions.h"
24#include "paramet.h"
25#include "logic.h"
26
27      REAL teta( ijb_u:ije_u,llm )
28      REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
29      REAL dteta( ijb_u:ije_u,llm )
30      INTEGER   l,ij
31
32      REAL hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )
33
34c
35      INTEGER ijb,ije,jjb,jje
36
37     
38      jjb=jj_begin
39      jje=jj_end
40
41c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
42      DO 5 l = 1,llm
43     
44      ijb=ij_begin
45      ije=ij_end
46     
47      if (pole_nord) ijb=ij_begin+iip1
48      if (pole_sud)  ije=ij_end-iip1
49     
50      DO 1  ij = ijb, ije - 1
51        hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
52   1  CONTINUE
53
54c    .... correction pour  hbxu(iip1,j,l)  .....
55c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
56
57CDIR$ IVDEP
58      DO 2 ij = ijb+iip1-1, ije, iip1
59        hbxu( ij, l ) = hbxu( ij - iim, l )
60   2  CONTINUE
61
62      ijb=ij_begin-iip1
63      if (pole_nord) ijb=ij_begin
64     
65      DO 3 ij = ijb,ije
66        hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
67   3  CONTINUE
68
69       if (.not. pole_sud) then
70          hbxu(ije+1:ije+iip1,l) = 0
71          hbyv(ije+1:ije+iip1,l) = 0
72        endif
73       
74   5  CONTINUE
75c$OMP END DO NOWAIT
76       
77       
78        CALL  convflu_loc ( hbxu, hbyv, llm, dteta )
79
80
81c    stockage dans  dh de la convergence horizont. filtree' du  flux
82c                  ....                           ...........
83c           d'enthalpie potentielle .
84     
85     
86      CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm,
87     &                2, 2, .true., 1)
88     
89     
90      RETURN
91      END
Note: See TracBrowser for help on using the repository browser.