source: LMDZ6/branches/Amaury_dev/libf/dyn3d/dteta1.F90 @ 5105

Last change on this file since 5105 was 5105, checked in by abarral, 3 months ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

  • 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.6 KB
Line 
1! $Header$
2
3SUBROUTINE dteta1 (teta, pbaru, pbarv, dteta)
4  IMPLICIT NONE
5
6  !=======================================================================
7  !
8  !   Auteur:  P. Le Van
9  !   -------
10  ! Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
11  !
12  !   ********************************************************************
13  !   ... calcul du terme de convergence horizontale du flux d'enthalpie
14  !    potentielle   ......
15  !   ********************************************************************
16  !  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
17  ! dteta                 sont des arguments de sortie pour le s-pg ....
18  !
19  !=======================================================================
20
21  include "dimensions.h"
22  include "paramet.h"
23
24  REAL :: teta(ip1jmp1, llm), pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
25  REAL :: dteta(ip1jmp1, llm)
26  INTEGER :: l, ij
27
28  REAL :: hbyv(ip1jm, llm), hbxu(ip1jmp1, llm)
29
30  !
31
32  DO l = 1, llm
33
34    DO ij = iip2, ip1jm - 1
35      hbxu(ij, l) = pbaru(ij, l) * 0.5 * (teta(ij, l) + teta(ij + 1, l))
36    END DO
37
38    !    .... correction pour  hbxu(iip1,j,l)  .....
39    !    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
40
41    !DIR$ IVDEP
42    DO ij = iip1 + iip1, ip1jm, iip1
43      hbxu(ij, l) = hbxu(ij - iim, l)
44    END DO
45
46    DO ij = 1, ip1jm
47      hbyv(ij, l) = pbarv(ij, l) * 0.5 * (teta(ij, l) + teta(ij + iip1, l))
48    END DO
49
50  END DO
51
52  CALL  convflu (hbxu, hbyv, llm, dteta)
53
54
55  !    stockage dans  dh de la convergence horizont. filtree' du  flux
56  ! ....                           ...........
57  ! d'enthalpie potentielle .
58
59  CALL filtreg(dteta, jjp1, llm, 2, 2, .TRUE., 1)
60
61  !
62
63END SUBROUTINE dteta1
Note: See TracBrowser for help on using the repository browser.