source: LMDZ6/trunk/libf/dyn3dmem/dteta1_loc.f90 @ 5278

Last change on this file since 5278 was 5272, checked in by abarral, 2 days ago

Turn paramet.h into a module

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 2.3 KB
Line 
1SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta)
2  USE parallel_lmdz
3  USE write_field_p
4  USE mod_filtreg_p
5  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
6  USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
7          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
8IMPLICIT NONE
9
10  !=======================================================================
11  !
12  !   Auteur:  P. Le Van
13  !   -------
14  ! Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
15  !
16  !   ********************************************************************
17  !   ... calcul du terme de convergence horizontale du flux d'enthalpie
18  !    potentielle   ......
19  !   ********************************************************************
20  !  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
21  ! dteta                 sont des arguments de sortie pour le s-pg ....
22  !
23  !=======================================================================
24  REAL :: teta( ijb_u:ije_u,llm )
25  REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
26  REAL :: dteta( ijb_u:ije_u,llm )
27  INTEGER :: l,ij
28
29  REAL :: hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )
30
31  !
32  INTEGER :: ijb,ije,jjb,jje
33
34
35  jjb=jj_begin
36  jje=jj_end
37
38!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
39  DO l = 1,llm
40
41  ijb=ij_begin
42  ije=ij_end
43
44  if (pole_nord) ijb=ij_begin+iip1
45  if (pole_sud)  ije=ij_end-iip1
46
47  DO  ij = ijb, ije - 1
48    hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
49  END DO
50
51  !    .... correction pour  hbxu(iip1,j,l)  .....
52  !    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
53
54  !DIR$ IVDEP
55  DO ij = ijb+iip1-1, ije, iip1
56    hbxu( ij, l ) = hbxu( ij - iim, l )
57  END DO
58
59  ijb=ij_begin-iip1
60  if (pole_nord) ijb=ij_begin
61
62  DO ij = ijb,ije
63    hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
64  END DO
65
66   if (.not. pole_sud) then
67      hbxu(ije+1:ije+iip1,l) = 0
68      hbyv(ije+1:ije+iip1,l) = 0
69    endif
70
71  END DO
72!$OMP END DO NOWAIT
73
74
75    CALL  convflu_loc ( hbxu, hbyv, llm, dteta )
76
77
78  !    stockage dans  dh de la convergence horizont. filtree' du  flux
79               ! ....                           ...........
80        ! d'enthalpie potentielle .
81
82
83  CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, &
84        2, 2, .true., 1)
85
86
87  RETURN
88END SUBROUTINE dteta1_loc
Note: See TracBrowser for help on using the repository browser.