source: LMDZ5/branches/LF-private/libf/dyn3dmem/dteta1_loc.F @ 5394

Last change on this file since 5394 was 1823, checked in by Ehouarn Millour, 11 years ago

Remplacement de parallel.F90 (en conflit avec orchidée) par parallel_lmdz.F90.
UG
.........................................
Renaming parallel.F90 (conflicting with orchidée) into parallel_lmdz.F90.
UG

File size: 2.3 KB
Line 
1      SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta)
2      USE parallel_lmdz
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.