GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d/dteta1.F Lines: 15 15 100.0 %
Date: 2023-06-30 12:56:34 Branches: 8 8 100.0 %

Line Branch Exec Source
1
!
2
! $Header$
3
!
4
1729
      SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
5
      IMPLICIT NONE
6
7
c=======================================================================
8
c
9
c   Auteur:  P. Le Van
10
c   -------
11
c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
12
c
13
c   ********************************************************************
14
c   ... calcul du terme de convergence horizontale du flux d'enthalpie
15
c        potentielle   ......
16
c   ********************************************************************
17
c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
18
c     dteta 	          sont des arguments de sortie pour le s-pg ....
19
c
20
c=======================================================================
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
c
33
34
69160
      DO 5 l = 1,llm
35
36
68981913
      DO 1  ij = iip2, ip1jm - 1
37
68914482
      hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
38
67431
   1  CONTINUE
39
40
c    .... correction pour  hbxu(iip1,j,l)  .....
41
c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
42
43
CDIR$ IVDEP
44
2090361
      DO 2 ij = iip1+ iip1, ip1jm, iip1
45
2090361
      hbxu( ij, l ) = hbxu( ij - iim, l )
46
67431
   2  CONTINUE
47
48
49
71274567
      DO 3 ij = 1,ip1jm
50
71207136
      hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
51
67431
   3  CONTINUE
52
53
1729
   5  CONTINUE
54
55
56
1729
        CALL  convflu ( hbxu, hbyv, llm, dteta )
57
58
59
c    stockage dans  dh de la convergence horizont. filtree' du  flux
60
c                  ....                           ...........
61
c           d'enthalpie potentielle .
62
63
1729
      CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
64
65
c
66
1729
      RETURN
67
      END