/[lmdze]/trunk/Sources/dyn3d/enercin.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/enercin.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 206 by guez, Wed Apr 29 15:47:56 2015 UTC revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 1  Line 1 
1    module enercin_m
2    
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/enercin.F,v 1.1.1.1 2004/05/19  
 ! 12:53:06 lmdzadmin Exp $  
   
 SUBROUTINE enercin(vcov, ucov, vcont, ucont, ecin)  
   USE dimens_m  
   USE paramet_m  
   USE comgeom  
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! =======================================================================  contains
6    
7    ! Auteur: P. Le Van    SUBROUTINE enercin(vcov, ucov, vcont, ucont, ecin)
   ! -------  
8    
9    ! Objet:      ! From LMDZ4/libf/dyn3d/enercin.F, version 1.1.1.1 2004/05/19 12:53:06
   ! ------  
10    
11    ! *********************************************************************      USE dimens_m
12    ! .. calcul de l'energie cinetique aux niveaux s  ......      USE paramet_m
13    ! *********************************************************************      USE comgeom
   ! vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .  
   ! ecin         est  un  argument de sortie pour le s-pg  
14    
15    ! =======================================================================      ! =======================================================================
16    
17        ! Auteur: P. Le Van
18        ! -------
19    
20    REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm)      ! Objet:
21    REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm), ecin(ip1jmp1, llm)      ! ------
22    
23    REAL ecinni(iip1), ecinsi(iip1)      ! *********************************************************************
24        ! .. calcul de l'energie cinetique aux niveaux s  ......
25        ! *********************************************************************
26        ! vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .
27        ! ecin         est  un  argument de sortie pour le s-pg
28    
29    REAL ecinpn, ecinps      ! =======================================================================
   INTEGER l, ij, i  
30    
   REAL ssum  
31    
32        REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm)
33        REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm), ecin(ip1jmp1, llm)
34    
35        REAL ecinni(iip1), ecinsi(iip1)
36    
37    ! . V      REAL ecinpn, ecinps
38    ! i,j-1      INTEGER l, ij, i
39    
40    ! alpha4 .       . alpha1      REAL ssum
41    
42    
   ! U .      . P     . U  
   ! i-1,j    i,j      i,j  
43    
44    ! alpha3 .       . alpha2      ! . V
45        ! i,j-1
46    
47        ! alpha4 .       . alpha1
48    
   ! . V  
   ! i,j  
49    
50        ! U .      . P     . U
51        ! i-1,j    i,j      i,j
52    
53    ! L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :      ! alpha3 .       . alpha2
   ! Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +  
   ! 0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +  
   ! 0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +  
   ! 0.5 * V(i,  j)**2 *( alpha2 + alpha3 )  
54    
55    
56    DO l = 1, llm      ! . V
57        ! i,j
58    
     DO ij = iip2, ip1jm - 1  
       ecin(ij+1, l) = 0.5*(ucov(ij,l)*ucont(ij,l)*alpha3p4(ij+1)+ucov(ij+1,l) &  
         *ucont(ij+1,l)*alpha1p2(ij+1)+vcov(ij-iim,l)*vcont(ij-iim,l)*alpha1p4 &  
         (ij+1)+vcov(ij+1,l)*vcont(ij+1,l)*alpha2p3(ij+1))  
     END DO  
59    
60      ! ... correction pour  ecin(1,j,l)  ....      ! L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :
61      ! ...   ecin(1,j,l)= ecin(iip1,j,l) ...      ! Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
62        ! 0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
63        ! 0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
64        ! 0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
65    
     ! DIR$ IVDEP  
     DO ij = iip2, ip1jm, iip1  
       ecin(ij, l) = ecin(ij+iim, l)  
     END DO  
66    
67      ! calcul aux poles  .......      DO l = 1, llm
68    
69           DO ij = iip2, ip1jm - 1
70              ecin(ij+1, l) = 0.5*(ucov(ij,l)*ucont(ij,l)*alpha3p4(ij+1)+ucov(ij+1,l) &
71                   *ucont(ij+1,l)*alpha1p2(ij+1)+vcov(ij-iim,l)*vcont(ij-iim,l)*alpha1p4 &
72                   (ij+1)+vcov(ij+1,l)*vcont(ij+1,l)*alpha2p3(ij+1))
73           END DO
74    
75      DO i = 1, iim         ! ... correction pour  ecin(1,j,l)  ....
76        ecinni(i) = vcov(i, l)*vcont(i, l)*aire(i)         ! ...   ecin(1,j,l)= ecin(iip1,j,l) ...
77        ecinsi(i) = vcov(i+ip1jmi1, l)*vcont(i+ip1jmi1, l)*aire(i+ip1jm)  
78      END DO         ! DIR$ IVDEP
79           DO ij = iip2, ip1jm, iip1
80              ecin(ij, l) = ecin(ij+iim, l)
81           END DO
82    
83      ecinpn = 0.5*ssum(iim, ecinni, 1)/apoln         ! calcul aux poles  .......
84      ecinps = 0.5*ssum(iim, ecinsi, 1)/apols  
85    
86           DO i = 1, iim
87              ecinni(i) = vcov(i, l)*vcont(i, l)*aire(i)
88              ecinsi(i) = vcov(i+ip1jmi1, l)*vcont(i+ip1jmi1, l)*aire(i+ip1jm)
89           END DO
90    
91           ecinpn = 0.5*ssum(iim, ecinni, 1)/apoln
92           ecinps = 0.5*ssum(iim, ecinsi, 1)/apols
93    
94           DO ij = 1, iip1
95              ecin(ij, l) = ecinpn
96              ecin(ij+ip1jm, l) = ecinps
97           END DO
98    
     DO ij = 1, iip1  
       ecin(ij, l) = ecinpn  
       ecin(ij+ip1jm, l) = ecinps  
99      END DO      END DO
100    
101    END DO    END SUBROUTINE enercin
102    RETURN  
103  END SUBROUTINE enercin  end module enercin_m
Legend:
Removed from v.206  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21