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

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

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

trunk/dyn3d/limz.f revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/dyn3d/limz.f90 revision 81 by guez, Wed Mar 5 14:38:41 2014 UTC
# Line 1  Line 1 
 !  
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limz.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $  
 !  
       SUBROUTINE limz(s0,sz,sm,pente_max)  
 c  
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget  
 c  
 c    ********************************************************************  
 c     Shema  d'advection " pseudo amont " .  
 c    ********************************************************************  
 c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....  
 c  
 c  
 c   --------------------------------------------------------------------  
       use dimens_m  
       use paramet_m  
       use comconst  
       use disvert_m  
       use conf_gcm_m  
       use comgeom  
       IMPLICIT NONE  
 c  
 c  
 c  
 c   Arguments:  
 c   ----------  
       real pente_max  
       REAL s0(ip1jmp1,llm),sm(ip1jmp1,llm)  
       real sz(ip1jmp1,llm)  
 c  
 c      Local  
 c   ---------  
 c  
       INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju  
       integer n0,iadvplus(ip1jmp1,llm),nl(llm)  
 c  
       REAL q(ip1jmp1,llm)  
       real dzq(ip1jmp1,llm)  
   
   
       REAL new_m,zm  
       real dzqw(ip1jmp1)  
       real adzqw(ip1jmp1),dzqmax(ip1jmp1)  
   
       Logical extremum,first  
       save first  
   
       REAL      SSUM,CVMGP,CVMGT  
       integer ismax,ismin  
       EXTERNAL  SSUM, convflu,ismin,ismax  
   
       data first/.true./  
   
   
        DO  l = 1,llm  
          DO  ij=1,ip1jmp1  
                q(ij,l) = s0(ij,l) / sm ( ij,l )  
                dzq(ij,l) = sz(ij,l) /sm(ij,l)  
          ENDDO  
        ENDDO  
   
 c   calcul de la pente en haut et en bas de la maille  
        do ij=1,ip1jmp1  
        do l = 1, llm-1  
             dzqw(l)=q(ij,l+1)-q(ij,l)  
          enddo  
             dzqw(llm)=0.  
   
          do  l=1,llm  
             adzqw(l)=abs(dzqw(l))  
          enddo  
   
 c   calcul de la pente maximum dans la maille en valeur absolue  
   
          do l=2,llm-1  
             dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l))  
          enddo  
   
 c   calcul de la pente avec limitation  
   
          do l=2,llm-1  
             if(     dzqw(l-1)*dzqw(l).gt.0.  
      &         .and. dzq(ij,l)*dzqw(l).gt.0.) then  
               dzq(ij,l)=  
      &         sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))  
             else  
 c   extremum local  
                dzq(ij,l)=0.  
             endif  
          enddo  
   
          DO  l=1,llm  
                sz(ij,l) = dzq(ij,l)*sm(ij,l)  
          ENDDO  
1    
2         ENDDO  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limz.F,v 1.1.1.1 2004/05/19
3    ! 12:53:07 lmdzadmin Exp $
4    
5        RETURN  SUBROUTINE limz(s0, sz, sm, pente_max)
6        END  
7      ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
8    
9      ! ********************************************************************
10      ! Shema  d'advection " pseudo amont " .
11      ! ********************************************************************
12      ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
13    
14    
15      ! --------------------------------------------------------------------
16      USE dimens_m
17      USE paramet_m
18      USE comconst
19      USE disvert_m
20      USE conf_gcm_m
21      USE comgeom
22      IMPLICIT NONE
23    
24    
25    
26      ! Arguments:
27      ! ----------
28      REAL pente_max
29      REAL s0(ip1jmp1, llm), sm(ip1jmp1, llm)
30      REAL sz(ip1jmp1, llm)
31    
32      ! Local
33      ! ---------
34    
35      INTEGER ij, l, j, i, iju, ijq, indu(ip1jmp1), niju
36      INTEGER n0, iadvplus(ip1jmp1, llm), nl(llm)
37    
38      REAL q(ip1jmp1, llm)
39      REAL dzq(ip1jmp1, llm)
40    
41    
42      REAL new_m, zm
43      REAL dzqw(ip1jmp1)
44      REAL adzqw(ip1jmp1), dzqmax(ip1jmp1)
45    
46      LOGICAL extremum, first
47      SAVE first
48    
49      REAL ssum, cvmgp, cvmgt
50      INTEGER ismax, ismin
51      EXTERNAL ssum, convflu, ismin, ismax
52    
53      DATA first/.TRUE./
54    
55    
56      DO l = 1, llm
57        DO ij = 1, ip1jmp1
58          q(ij, l) = s0(ij, l)/sm(ij, l)
59          dzq(ij, l) = sz(ij, l)/sm(ij, l)
60        END DO
61      END DO
62    
63      ! calcul de la pente en haut et en bas de la maille
64      DO ij = 1, ip1jmp1
65        DO l = 1, llm - 1
66          dzqw(l) = q(ij, l+1) - q(ij, l)
67        END DO
68        dzqw(llm) = 0.
69    
70        DO l = 1, llm
71          adzqw(l) = abs(dzqw(l))
72        END DO
73    
74        ! calcul de la pente maximum dans la maille en valeur absolue
75    
76        DO l = 2, llm - 1
77          dzqmax(l) = pente_max*min(adzqw(l-1), adzqw(l))
78        END DO
79    
80        ! calcul de la pente avec limitation
81    
82        DO l = 2, llm - 1
83          IF (dzqw(l-1)*dzqw(l)>0. .AND. dzq(ij,l)*dzqw(l)>0.) THEN
84            dzq(ij, l) = sign(min(abs(dzq(ij,l)),dzqmax(l)), dzq(ij,l))
85          ELSE
86            ! extremum local
87            dzq(ij, l) = 0.
88          END IF
89        END DO
90    
91        DO l = 1, llm
92          sz(ij, l) = dzq(ij, l)*sm(ij, l)
93        END DO
94    
95      END DO
96    
97      RETURN
98    END SUBROUTINE limz
Legend:
Removed from v.76  
changed lines
  Added in v.81
  ViewVC Help
Powered by ViewVC 1.1.21