/[lmdze]/trunk/dyn3d/Vlsplt/vlsplt.f
ViewVC logotype

Diff of /trunk/dyn3d/Vlsplt/vlsplt.f

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

revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC
# Line 1  Line 1 
1  !  SUBROUTINE vlsplt(q, pente_max, masse, w, pbaru, pbarv, pdt)
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/vlsplt.F,v 1.2  
 !     2005/02/24 12:16:57 fairhead Exp $  
 !  
 !  
 !  
   
       SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt)  
 !  
 !     Auteurs:   P.Le Van, F.Hourdin, F.Forget  
 !  
 !    *************************************************************  
 !     Shema  d'advection " pseudo amont " .  
 !    **************************************************************  
 !     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....  
 !  
 !   pente_max facteur de limitation des pentes: 2 en general  
 !                                               0 pour un schema amont  
 !   pbaru,pbarv,w flux de masse en u ,v ,w  
 !   pdt pas de temps  
 !  
 !   ---------------------------------------------------------------  
       use dimens_m  
       use paramet_m  
       use comconst  
       use comvert  
       use logic  
       IMPLICIT NONE  
 !  
   
 !  
 !   Arguments:  
 !   ----------  
       REAL masse(ip1jmp1,llm),pente_max  
 !      REAL masse(iip1,jjp1,llm),pente_max  
       REAL, intent(in):: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)  
       REAL q(ip1jmp1,llm)  
 !      REAL q(iip1,jjp1,llm)  
       REAL w(ip1jmp1,llm)  
       real, intent(in):: pdt  
 !  
 !      Local  
 !   ---------  
 !  
       INTEGER i,ij,l,j,ii  
       INTEGER ijlqmin,iqmin,jqmin,lqmin  
 !  
       REAL zm(ip1jmp1,llm),newmasse  
       REAL mu(ip1jmp1,llm)  
       REAL mv(ip1jm,llm)  
       REAL mw(ip1jmp1,llm+1)  
       REAL zq(ip1jmp1,llm),zz  
       REAL dqx(ip1jmp1,llm),dqy(ip1jmp1,llm),dqz(ip1jmp1,llm)  
       REAL second,temps0,temps1,temps2,temps3  
       REAL ztemps1,ztemps2,ztemps3  
       REAL zzpbar, zzw  
       LOGICAL testcpu  
       SAVE testcpu  
       SAVE temps1,temps2,temps3  
       INTEGER iminn,imaxx  
   
       REAL qmin,qmax  
       DATA qmin,qmax/0.,1.e33/  
       DATA testcpu/.false./  
       DATA temps1,temps2,temps3/0.,0.,0./  
   
   
         zzpbar = 0.5 * pdt  
         zzw    = pdt  
       DO l=1,llm  
         DO ij = iip2,ip1jm  
             mu(ij,l)=pbaru(ij,l) * zzpbar  
          ENDDO  
          DO ij=1,ip1jm  
             mv(ij,l)=pbarv(ij,l) * zzpbar  
          ENDDO  
          DO ij=1,ip1jmp1  
             mw(ij,l)=w(ij,l) * zzw  
          ENDDO  
       ENDDO  
   
       DO ij=1,ip1jmp1  
          mw(ij,llm+1)=0.  
       ENDDO  
   
       CALL SCOPY(ijp1llm,q,1,zq,1)  
       CALL SCOPY(ijp1llm,masse,1,zm,1)  
   
       call vlx(zq,pente_max,zm,mu)  
   
       call vly(zq,pente_max,zm,mv)  
       call vlz(zq,pente_max,zm,mw)  
   
   
       call vly(zq,pente_max,zm,mv)  
   
   
       call vlx(zq,pente_max,zm,mu)  
   
   
       DO l=1,llm  
          DO ij=1,ip1jmp1  
            q(ij,l)=zq(ij,l)  
          ENDDO  
          DO ij=1,ip1jm+1,iip1  
             q(ij+iim,l)=q(ij,l)  
          ENDDO  
       ENDDO  
2    
3        RETURN    ! From LMDZ4/libf/dyn3d/vlsplt.F, version 1.2 2005/02/24 12:16:57 fairhead
4        END    ! Auteurs: P. Le Van, F. Hourdin, F. Forget
5    
6      ! Shema d'advection "pseudo amont".
7      ! q, pbaru, pbarv, w sont des arguments d'entree pour le sous-programme.
8      ! pente_max facteur de limitation des pentes : 2 en general
9      ! 0 pour un schema amont
10      ! pbaru, pbarv, w flux de masse en u, v, w
11      ! pdt pas de temps
12    
13      USE dimens_m, ONLY: iim, llm
14      USE paramet_m, ONLY: iip1, iip2, ijp1llm, ip1jm, ip1jmp1
15    
16      IMPLICIT NONE
17    
18      ! Arguments:
19    
20      REAL masse(ip1jmp1, llm), pente_max
21      REAL, intent(in):: pbaru( ip1jmp1, llm ), pbarv( ip1jm, llm)
22      REAL, intent(inout):: q(ip1jmp1, llm)
23      REAL w(ip1jmp1, llm)
24      real, intent(in):: pdt
25    
26      ! Local
27    
28      INTEGER i, ij, l, j, ii
29      INTEGER ijlqmin, iqmin, jqmin, lqmin
30    
31      REAL zm(ip1jmp1, llm), newmasse
32      REAL mu(ip1jmp1, llm)
33      REAL mv(ip1jm, llm)
34      REAL mw(ip1jmp1, llm+1)
35      REAL zq(ip1jmp1, llm), zz
36      REAL dqx(ip1jmp1, llm), dqy(ip1jmp1, llm), dqz(ip1jmp1, llm)
37      REAL second, temps0, temps1, temps2, temps3
38      REAL ztemps1, ztemps2, ztemps3
39      REAL zzpbar, zzw
40      LOGICAL testcpu
41      SAVE testcpu
42      SAVE temps1, temps2, temps3
43      INTEGER iminn, imaxx
44    
45      REAL qmin, qmax
46      DATA qmin, qmax/0., 1.e33/
47      DATA testcpu/.false./
48      DATA temps1, temps2, temps3/0., 0., 0./
49    
50      !---------------------------------------------------------------
51    
52      zzpbar = 0.5 * pdt
53      zzw = pdt
54      DO l = 1, llm
55         DO ij = iip2, ip1jm
56            mu(ij, l) = pbaru(ij, l) * zzpbar
57         ENDDO
58         DO ij = 1, ip1jm
59            mv(ij, l) = pbarv(ij, l) * zzpbar
60         ENDDO
61         DO ij = 1, ip1jmp1
62            mw(ij, l) = w(ij, l) * zzw
63         ENDDO
64      ENDDO
65    
66      DO ij = 1, ip1jmp1
67         mw(ij, llm+1) = 0.
68      ENDDO
69    
70      zq = q
71      zm = masse
72    
73      call vlx(zq, pente_max, zm, mu)
74    
75      call vly(zq, pente_max, zm, mv)
76      call vlz(zq, pente_max, zm, mw)
77    
78      call vly(zq, pente_max, zm, mv)
79    
80      call vlx(zq, pente_max, zm, mu)
81    
82      q = zq
83      DO ij = 1, ip1jm+1, iip1
84         q(ij+iim, :) = q(ij, :)
85      ENDDO
86    
87    END SUBROUTINE vlsplt
Legend:
Removed from v.31  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21