My Project
 All Classes Files Functions Variables Macros
dteta1_loc.F
Go to the documentation of this file.
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 
7 c=======================================================================
8 c
9 c Auteur: P. Le Van
10 c -------
11 c Modif F.Forget 03/94 (on retire q et dq pour construire dteta1)
12 c
13 c ********************************************************************
14 c ... calcul du terme de convergence horizontale du flux d'enthalpie
15 c potentielle ......
16 c ********************************************************************
17 c .. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg ....
18 c dteta sont des arguments de sortie pour le s-pg ....
19 c
20 c=======================================================================
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 
34 c
35  INTEGER ijb,ije,jjb,jje
36 
37 
38  jjb=jj_begin
39  jje=jj_end
40 
41 c$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 
54 c .... correction pour hbxu(iip1,j,l) .....
55 c .... hbxu(iip1,j,l)= hbxu(1,j,l) ....
56 
57 CDIR$ 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
75 c$OMP END DO NOWAIT
76 
77 
78  CALL convflu_loc( hbxu, hbyv, llm, dteta )
79 
80 
81 c stockage dans dh de la convergence horizont. filtree' du flux
82 c .... ...........
83 c 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