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

Diff of /trunk/dyn3d/dudv2.f

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

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