source: LMDZ6/trunk/libf/dyn3d/dteta1.f90

Last change on this file was 5246, checked in by abarral, 22 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • 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.7 KB
Line 
1!
2! $Header$
3!
4SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
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( 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  !
33
34  DO l = 1,llm
35
36  DO  ij = iip2, ip1jm - 1
37  hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
38  END DO
39
40  !    .... correction pour  hbxu(iip1,j,l)  .....
41  !    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
42
43  !DIR$ IVDEP
44  DO ij = iip1+ iip1, ip1jm, iip1
45  hbxu( ij, l ) = hbxu( ij - iim, l )
46  END DO
47
48
49  DO ij = 1,ip1jm
50  hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
51  END DO
52
53  END DO
54
55
56    CALL  convflu ( hbxu, hbyv, llm, dteta )
57
58
59  !    stockage dans  dh de la convergence horizont. filtree' du  flux
60               ! ....                           ...........
61        ! d'enthalpie potentielle .
62
63  CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
64
65  !
66  RETURN
67END SUBROUTINE dteta1
Note: See TracBrowser for help on using the repository browser.