1 | |
---|
2 | ! $Header$ |
---|
3 | |
---|
4 | SUBROUTINE limz(s0,sz,sm,pente_max) |
---|
5 | ! |
---|
6 | ! Auteurs: P.Le Van, F.Hourdin, F.Forget |
---|
7 | ! |
---|
8 | ! ******************************************************************** |
---|
9 | ! Shema d'advection " pseudo amont " . |
---|
10 | ! ******************************************************************** |
---|
11 | ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg .... |
---|
12 | ! |
---|
13 | ! |
---|
14 | ! -------------------------------------------------------------------- |
---|
15 | IMPLICIT NONE |
---|
16 | ! |
---|
17 | include "dimensions.h" |
---|
18 | include "paramet.h" |
---|
19 | include "comgeom.h" |
---|
20 | ! |
---|
21 | ! |
---|
22 | ! Arguments: |
---|
23 | ! ---------- |
---|
24 | real :: pente_max |
---|
25 | REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm) |
---|
26 | real :: sz(ip1jmp1,llm) |
---|
27 | ! |
---|
28 | ! Local |
---|
29 | ! --------- |
---|
30 | ! |
---|
31 | INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju |
---|
32 | integer :: n0,iadvplus(ip1jmp1,llm),nl(llm) |
---|
33 | ! |
---|
34 | REAL :: q(ip1jmp1,llm) |
---|
35 | real :: dzq(ip1jmp1,llm) |
---|
36 | |
---|
37 | |
---|
38 | REAL :: new_m,zm |
---|
39 | real :: dzqw(ip1jmp1) |
---|
40 | real :: adzqw(ip1jmp1),dzqmax(ip1jmp1) |
---|
41 | |
---|
42 | Logical :: extremum,first |
---|
43 | save first |
---|
44 | |
---|
45 | REAL :: SSUM |
---|
46 | integer :: ismax,ismin |
---|
47 | EXTERNAL SSUM, ismin,ismax |
---|
48 | |
---|
49 | data first/.TRUE./ |
---|
50 | |
---|
51 | |
---|
52 | DO l = 1,llm |
---|
53 | DO ij=1,ip1jmp1 |
---|
54 | q(ij,l) = s0(ij,l) / sm ( ij,l ) |
---|
55 | dzq(ij,l) = sz(ij,l) /sm(ij,l) |
---|
56 | ENDDO |
---|
57 | ENDDO |
---|
58 | |
---|
59 | ! calcul de la pente en haut et en bas de la maille |
---|
60 | do ij=1,ip1jmp1 |
---|
61 | do l = 1, llm-1 |
---|
62 | dzqw(l)=q(ij,l+1)-q(ij,l) |
---|
63 | enddo |
---|
64 | dzqw(llm)=0. |
---|
65 | |
---|
66 | do l=1,llm |
---|
67 | adzqw(l)=abs(dzqw(l)) |
---|
68 | enddo |
---|
69 | |
---|
70 | ! calcul de la pente maximum dans la maille en valeur absolue |
---|
71 | |
---|
72 | do l=2,llm-1 |
---|
73 | dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l)) |
---|
74 | enddo |
---|
75 | |
---|
76 | ! calcul de la pente avec limitation |
---|
77 | |
---|
78 | do l=2,llm-1 |
---|
79 | if( dzqw(l-1)*dzqw(l)>0. & |
---|
80 | .and. dzq(ij,l)*dzqw(l)>0.) then |
---|
81 | dzq(ij,l)= & |
---|
82 | sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l)) |
---|
83 | else |
---|
84 | ! extremum local |
---|
85 | dzq(ij,l)=0. |
---|
86 | endif |
---|
87 | enddo |
---|
88 | |
---|
89 | DO l=1,llm |
---|
90 | sz(ij,l) = dzq(ij,l)*sm(ij,l) |
---|
91 | ENDDO |
---|
92 | |
---|
93 | ENDDO |
---|
94 | |
---|
95 | RETURN |
---|
96 | END SUBROUTINE limz |
---|