source: trunk/LMDZ.GENERIC/libf/dyn3d/enercin.F @ 1422

Last change on this file since 1422 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 2.5 KB
Line 
1      SUBROUTINE enercin ( vcov, ucov, vcont, ucont, ecin )
2      IMPLICIT NONE
3
4c=======================================================================
5c
6c   Auteur: P. Le Van
7c   -------
8c
9c   Objet:
10c   ------
11c
12c *********************************************************************
13c .. calcul de l'energie cinetique aux niveaux s  ......
14c *********************************************************************
15c  vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .
16c  ecin         est  un  argument de sortie pour le s-pg
17c
18c=======================================================================
19
20#include "dimensions.h"
21#include "paramet.h"
22#include "comgeom.h"
23
24      REAL vcov( ip1jm,llm ),vcont( ip1jm,llm ),
25     * ucov( ip1jmp1,llm ),ucont( ip1jmp1,llm ),ecin( ip1jmp1,llm )
26
27      REAL ecinni( iip1 ),ecinsi( iip1 )
28
29      REAL ecinpn, ecinps
30      INTEGER     l,ij,i
31
32      EXTERNAL    SSUM
33      REAL        SSUM
34
35
36
37c                 . V
38c                i,j-1
39
40c      alpha4 .       . alpha1
41
42
43c        U .      . P     . U
44c       i-1,j    i,j      i,j
45
46c      alpha3 .       . alpha2
47
48
49c                 . V
50c                i,j
51
52c   
53c  L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :
54c       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
55c              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
56c              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
57c              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
58
59
60      DO 5 l = 1,llm
61
62      DO 1  ij = iip2, ip1jm -1
63      ecin( ij+1, l )  =    0.5  *
64     * (   ucov( ij   ,l ) * ucont( ij   ,l ) * alpha3p4( ij +1 )   +
65     *     ucov( ij+1 ,l ) * ucont( ij+1 ,l ) * alpha1p2( ij +1 )   +
66     *     vcov(ij-iim,l ) * vcont(ij-iim,l ) * alpha1p4( ij +1 )   +
67     *     vcov( ij+ 1,l ) * vcont( ij+ 1,l ) * alpha2p3( ij +1 )   )
68   1  CONTINUE
69
70c    ... correction pour  ecin(1,j,l)  ....
71c    ...   ecin(1,j,l)= ecin(iip1,j,l) ...
72
73CDIR$ IVDEP
74      DO 2 ij = iip2, ip1jm, iip1
75      ecin( ij,l ) = ecin( ij + iim, l )
76   2  CONTINUE
77
78c     calcul aux poles  .......
79
80
81      DO 3 i = 1, iim
82      ecinni(i) = vcov(    i  ,  l) * vcont(    i    ,l) * aire(   i   )
83      ecinsi(i) = vcov(i+ip1jmi1,l) * vcont(i+ip1jmi1,l) * aire(i+ip1jm)
84   3  CONTINUE
85
86      ecinpn = 0.5 * SSUM( iim,ecinni,1 ) / apoln
87      ecinps = 0.5 * SSUM( iim,ecinsi,1 ) / apols
88
89      DO 4 ij = 1,iip1
90      ecin(   ij     , l ) = ecinpn
91      ecin( ij+ ip1jm, l ) = ecinps
92   4  CONTINUE
93
94   5  CONTINUE
95      RETURN
96      END
Note: See TracBrowser for help on using the repository browser.