/[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/Sources/dyn3d/limz.f revision 157 by guez, Mon Jul 20 16:01:49 2015 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
36    
37      REAL q(ip1jmp1, llm)
38      REAL dzq(ip1jmp1, llm)
39    
40      REAL dzqw(ip1jmp1)
41      REAL adzqw(ip1jmp1), dzqmax(ip1jmp1)
42    
43      REAL ssum
44      INTEGER ismax, ismin
45      EXTERNAL ssum, convflu, ismin, ismax
46    
47      DO l = 1, llm
48        DO ij = 1, ip1jmp1
49          q(ij, l) = s0(ij, l)/sm(ij, l)
50          dzq(ij, l) = sz(ij, l)/sm(ij, l)
51        END DO
52      END DO
53    
54      ! calcul de la pente en haut et en bas de la maille
55      DO ij = 1, ip1jmp1
56        DO l = 1, llm - 1
57          dzqw(l) = q(ij, l+1) - q(ij, l)
58        END DO
59        dzqw(llm) = 0.
60    
61        DO l = 1, llm
62          adzqw(l) = abs(dzqw(l))
63        END DO
64    
65        ! calcul de la pente maximum dans la maille en valeur absolue
66    
67        DO l = 2, llm - 1
68          dzqmax(l) = pente_max*min(adzqw(l-1), adzqw(l))
69        END DO
70    
71        ! calcul de la pente avec limitation
72    
73        DO l = 2, llm - 1
74          IF (dzqw(l-1)*dzqw(l)>0. .AND. dzq(ij,l)*dzqw(l)>0.) THEN
75            dzq(ij, l) = sign(min(abs(dzq(ij,l)),dzqmax(l)), dzq(ij,l))
76          ELSE
77            ! extremum local
78            dzq(ij, l) = 0.
79          END IF
80        END DO
81    
82        DO l = 1, llm
83          sz(ij, l) = dzq(ij, l)*sm(ij, l)
84        END DO
85    
86      END DO
87    
88      RETURN
89    END SUBROUTINE limz
Legend:
Removed from v.76  
changed lines
  Added in v.157
  ViewVC Help
Powered by ViewVC 1.1.21