LMDZ
dteta1_p.F
Go to the documentation of this file.
1  SUBROUTINE dteta1_p ( teta, pbaru, pbarv, dteta)
3  USE write_field_p
4  IMPLICIT NONE
5 
6 c=======================================================================
7 c
8 c Auteur: P. Le Van
9 c -------
10 c Modif F.Forget 03/94 (on retire q et dq pour construire dteta1)
11 c
12 c ********************************************************************
13 c ... calcul du terme de convergence horizontale du flux d'enthalpie
14 c potentielle ......
15 c ********************************************************************
16 c .. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg ....
17 c dteta sont des arguments de sortie pour le s-pg ....
18 c
19 c=======================================================================
20 
21 
22 #include "dimensions.h"
23 #include "paramet.h"
24 #include "logic.h"
25 
26  REAL teta( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
27  REAL dteta( ip1jmp1,llm )
28  INTEGER l,ij
29 
30  REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )
31 
32 c
33  INTEGER ijb,ije,jjb,jje
34 
35 
36  jjb=jj_begin
37  jje=jj_end
38 
39 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
40  DO 5 l = 1,llm
41 
42  ijb=ij_begin
43  ije=ij_end
44 
45  if (pole_nord) ijb=ij_begin+iip1
46  if (pole_sud) ije=ij_end-iip1
47 
48  DO 1 ij = ijb, ije - 1
49  hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
50  1 CONTINUE
51 
52 c .... correction pour hbxu(iip1,j,l) .....
53 c .... hbxu(iip1,j,l)= hbxu(1,j,l) ....
54 
55 CDIR$ IVDEP
56  DO 2 ij = ijb+iip1-1, ije, iip1
57  hbxu( ij, l ) = hbxu( ij - iim, l )
58  2 CONTINUE
59 
60  ijb=ij_begin-iip1
61  if (pole_nord) ijb=ij_begin
62 
63  DO 3 ij = ijb,ije
64  hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
65  3 CONTINUE
66 
67  if (.not. pole_sud) then
68  hbxu(ije+1:ije+iip1,l) = 0
69  hbyv(ije+1:ije+iip1,l) = 0
70  endif
71 
72  5 CONTINUE
73 c$OMP END DO NOWAIT
74 
75 
76  CALL convflu_p ( hbxu, hbyv, llm, dteta )
77 
78 
79 c stockage dans dh de la convergence horizont. filtree' du flux
80 c .... ...........
81 c d'enthalpie potentielle .
82 
83 
84  CALL filtreg_p( dteta,jjb,jje,jjp1, llm, 2, 2, .true., 1)
85 
86 
87  RETURN
88  END
!$Header llmm1 INTEGER ip1jmp1
Definition: paramet.h:14
subroutine filtreg_p(champ, ibeg, iend, nlat, nbniv, ifiltre, iaire, griscal, iter)
Definition: filtreg_p.F:5
integer, save jj_end
integer, save jj_begin
integer, save ij_end
logical, save pole_sud
subroutine convflu_p(xflu, yflu, nbniv, convfl)
Definition: convflu_p.F:2
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
subroutine dteta1_p(teta, pbaru, pbarv, dteta)
Definition: dteta1_p.F:2
!$Header llmm1 INTEGER ip1jm
Definition: paramet.h:14
logical, save pole_nord
!$Header jjp1
Definition: paramet.h:14
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
integer, save ij_begin
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24