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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 134 - (hide annotations)
Wed Apr 29 15:47:56 2015 UTC (9 years ago) by guez
File size: 2058 byte(s)
Sources inside, compilation outside.
1 guez 3
2 guez 81 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limz.F,v 1.1.1.1 2004/05/19
3     ! 12:53:07 lmdzadmin Exp $
4 guez 3
5 guez 81 SUBROUTINE limz(s0, sz, sm, pente_max)
6 guez 3
7 guez 81 ! Auteurs: P.Le Van, F.Hourdin, F.Forget
8 guez 3
9 guez 81 ! ********************************************************************
10     ! Shema d'advection " pseudo amont " .
11     ! ********************************************************************
12     ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg ....
13 guez 3
14    
15 guez 81 ! --------------------------------------------------------------------
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 guez 3
24    
25    
26 guez 81 ! Arguments:
27     ! ----------
28     REAL pente_max
29     REAL s0(ip1jmp1, llm), sm(ip1jmp1, llm)
30     REAL sz(ip1jmp1, llm)
31 guez 3
32 guez 81 ! Local
33     ! ---------
34 guez 3
35 guez 81 INTEGER ij, l, j, i, iju, ijq, indu(ip1jmp1), niju
36     INTEGER n0, iadvplus(ip1jmp1, llm), nl(llm)
37 guez 3
38 guez 81 REAL q(ip1jmp1, llm)
39     REAL dzq(ip1jmp1, llm)
40 guez 3
41    
42 guez 81 REAL new_m, zm
43     REAL dzqw(ip1jmp1)
44     REAL adzqw(ip1jmp1), dzqmax(ip1jmp1)
45 guez 3
46 guez 81 LOGICAL extremum, first
47     SAVE first
48 guez 3
49 guez 81 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

  ViewVC Help
Powered by ViewVC 1.1.21