/[lmdze]/trunk/dyn3d/dudv2.f
ViewVC logotype

Diff of /trunk/dyn3d/dudv2.f

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

revision 87 by guez, Wed Mar 5 14:57:53 2014 UTC revision 88 by guez, Tue Mar 11 15:09:02 2014 UTC
# Line 1  Line 1 
1    module dudv2_m
2    
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dudv2.F,v 1.1.1.1 2004/05/19  
 ! 12:53:06 lmdzadmin Exp $  
   
 SUBROUTINE dudv2(teta, pkf, bern, du, dv)  
   
   USE dimens_m  
   USE paramet_m  
   USE disvert_m  
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! =======================================================================  contains
   
   ! Auteur:  P. Le Van  
   ! -------  
6    
7    ! Objet:    SUBROUTINE dudv2(teta, pkf, bern, du, dv)
   ! ------  
8    
9    ! *****************************************************************      ! From LMDZ4/libf/dyn3d/dudv2.F, version 1.1.1.1, 2004/05/19 12:53:06
   ! ..... calcul du terme de pression (gradient de p/densite )   et  
   ! du terme de ( -gradient de la fonction de Bernouilli ) ...  
   ! *****************************************************************  
   ! Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..  
10    
11        ! Author: P. Le Van
12    
13    ! teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....      ! Objet: calcul du terme de pression (gradient de p/densité) et du
14    ! du et dv          sont des arguments de sortie pour le s-pg  ....      ! terme de (- gradient de la fonction de Bernouilli). Ces termes
15        ! sont ajoutes a d(ucov)/dt et a d(vcov)/dt.
16    
17    ! =======================================================================      USE dimens_m, ONLY: iim, llm
18        USE paramet_m, ONLY: iip1, iip2, ip1jm, ip1jmp1
19    
20        REAL, INTENT(IN):: teta(ip1jmp1, llm)
21        REAL, INTENT(IN):: pkf(ip1jmp1, llm)
22        real bern(ip1jmp1, llm), du(ip1jmp1, llm), dv(ip1jm, llm)
23        ! teta , pkf, bern sont des arguments d'entree pour le s-pg
24        ! du et dv sont des arguments de sortie pour le s-pg
25    
26    REAL, INTENT (IN) :: teta(ip1jmp1, llm)      ! Local:
27    REAL pkf(ip1jmp1, llm), bern(ip1jmp1, llm), du(ip1jmp1, llm), &      INTEGER l, ij
     dv(ip1jm, llm)  
   INTEGER l, ij  
28    
29        !-----------------------------------------------------------------
30    
31    DO l = 1, llm      DO l = 1, llm
32           DO ij = iip2, ip1jm - 1
33      DO ij = iip2, ip1jm - 1            du(ij, l) = du(ij, l) + 0.5 * (teta(ij, l) + teta(ij + 1, l)) &
34        du(ij, l) = du(ij, l) + 0.5*(teta(ij,l)+teta(ij+1,l))*(pkf(ij,l)-pkf(ij &                 * (pkf(ij, l) - pkf(ij + 1, l)) + bern(ij, l) - bern(ij + 1, l)
35          +1,l)) + bern(ij, l) - bern(ij+1, l)         END DO
     END DO  
   
   
     ! .....  correction  pour du(iip1,j,l),  j=2,jjm   ......  
     ! ...          du(iip1,j,l) = du(1,j,l)                 ...  
   
     ! DIR$ IVDEP  
     DO ij = iip1 + iip1, ip1jm, iip1  
       du(ij, l) = du(ij-iim, l)  
     END DO  
36    
37           ! correction pour du(iip1, j, l), j=2, jjm
38           ! du(iip1, j, l) = du(1, j, l)
39           DO ij = iip1 + iip1, ip1jm, iip1
40              du(ij, l) = du(ij - iim, l)
41           END DO
42    
43      DO ij = 1, ip1jm         DO ij = 1, ip1jm
44        dv(ij, l) = dv(ij, l) + 0.5*(teta(ij,l)+teta(ij+iip1,l))*(pkf(ij+iip1,l &            dv(ij, l) = dv(ij, l) + 0.5 * (teta(ij, l) + teta(ij + iip1, l)) &
45          )-pkf(ij,l)) + bern(ij+iip1, l) - bern(ij, l)                 * (pkf(ij + iip1, l) - pkf(ij, l)) + bern(ij + iip1, l) &
46                   - bern(ij, l)
47           END DO
48      END DO      END DO
49    
50    END DO    END SUBROUTINE dudv2
51    
52    RETURN  end module dudv2_m
 END SUBROUTINE dudv2  
Legend:
Removed from v.87  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.21