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

Annotation of /trunk/dyn3d/limx.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 82 - (hide annotations)
Wed Mar 5 14:57:53 2014 UTC (10 years, 3 months ago) by guez
File size: 2320 byte(s)
Changed all ".f90" suffixes to ".f".
1 guez 3
2 guez 81 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limx.F,v 1.1.1.1 2004/05/19
3     ! 12:53:06 lmdzadmin Exp $
4 guez 3
5 guez 81 SUBROUTINE limx(s0, sx, 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 sx(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 dxq(ip1jmp1, llm)
40 guez 3
41    
42 guez 81 REAL new_m, zm
43     REAL dxqu(ip1jmp1)
44     REAL adxqu(ip1jmp1), dxqmax(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 guez 3
53 guez 81 DATA first/.TRUE./
54 guez 3
55 guez 81
56     DO l = 1, llm
57     DO ij = 1, ip1jmp1
58     q(ij, l) = s0(ij, l)/sm(ij, l)
59     dxq(ij, l) = sx(ij, l)/sm(ij, l)
60     END DO
61     END DO
62    
63     ! calcul de la pente a droite et a gauche de la maille
64    
65     DO l = 1, llm
66     DO ij = iip2, ip1jm - 1
67     dxqu(ij) = q(ij+1, l) - q(ij, l)
68     END DO
69     DO ij = iip1 + iip1, ip1jm, iip1
70     dxqu(ij) = dxqu(ij-iim)
71     END DO
72    
73     DO ij = iip2, ip1jm
74     adxqu(ij) = abs(dxqu(ij))
75     END DO
76    
77     ! calcul de la pente maximum dans la maille en valeur absolue
78    
79     DO ij = iip2 + 1, ip1jm
80     dxqmax(ij) = pente_max*min(adxqu(ij-1), adxqu(ij))
81     END DO
82    
83     DO ij = iip1 + iip1, ip1jm, iip1
84     dxqmax(ij-iim) = dxqmax(ij)
85     END DO
86    
87     ! calcul de la pente avec limitation
88    
89     DO ij = iip2 + 1, ip1jm
90     IF (dxqu(ij-1)*dxqu(ij)>0. .AND. dxq(ij,l)*dxqu(ij)>0.) THEN
91     dxq(ij, l) = sign(min(abs(dxq(ij,l)),dxqmax(ij)), dxq(ij,l))
92     ELSE
93     ! extremum local
94     dxq(ij, l) = 0.
95     END IF
96     END DO
97     DO ij = iip1 + iip1, ip1jm, iip1
98     dxq(ij-iim, l) = dxq(ij, l)
99     END DO
100    
101     DO ij = 1, ip1jmp1
102     sx(ij, l) = dxq(ij, l)*sm(ij, l)
103     END DO
104    
105     END DO
106    
107     RETURN
108     END SUBROUTINE limx

  ViewVC Help
Powered by ViewVC 1.1.21