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

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

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

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