source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90 @ 5133

Last change on this file since 5133 was 5117, checked in by abarral, 5 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

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