GCC Code Coverage Report


Directory: ./
File: dyn3d_common/limx.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 25 0.0%
Branches: 0 26 0.0%

Line Branch Exec Source
1 !
2 ! $Header$
3 !
4 SUBROUTINE limx(s0,sx,sm,pente_max)
5 c
6 c Auteurs: P.Le Van, F.Hourdin, F.Forget
7 c
8 c ********************************************************************
9 c Shema d'advection " pseudo amont " .
10 c ********************************************************************
11 c nq,iq,q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg ....
12 c
13 c
14 c --------------------------------------------------------------------
15 IMPLICIT NONE
16 c
17 include "dimensions.h"
18 include "paramet.h"
19 include "comgeom.h"
20 c
21 c
22 c Arguments:
23 c ----------
24 real pente_max
25 REAL s0(ip1jmp1,llm),sm(ip1jmp1,llm)
26 real sx(ip1jmp1,llm)
27 c
28 c Local
29 c ---------
30 c
31 INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
32 integer n0,iadvplus(ip1jmp1,llm),nl(llm)
33 c
34 REAL q(ip1jmp1,llm)
35 real dxq(ip1jmp1,llm)
36
37
38 REAL new_m,zm
39 real dxqu(ip1jmp1)
40 real adxqu(ip1jmp1),dxqmax(ip1jmp1)
41
42 Logical extremum,first
43 save first
44
45 REAL SSUM,CVMGP,CVMGT
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 dxq(ij,l) = sx(ij,l) /sm(ij,l)
56 ENDDO
57 ENDDO
58
59 c calcul de la pente a droite et a gauche de la maille
60
61 do l = 1, llm
62 do ij=iip2,ip1jm-1
63 dxqu(ij)=q(ij+1,l)-q(ij,l)
64 enddo
65 do ij=iip1+iip1,ip1jm,iip1
66 dxqu(ij)=dxqu(ij-iim)
67 enddo
68
69 do ij=iip2,ip1jm
70 adxqu(ij)=abs(dxqu(ij))
71 enddo
72
73 c calcul de la pente maximum dans la maille en valeur absolue
74
75 do ij=iip2+1,ip1jm
76 dxqmax(ij)=pente_max*min(adxqu(ij-1),adxqu(ij))
77 enddo
78
79 do ij=iip1+iip1,ip1jm,iip1
80 dxqmax(ij-iim)=dxqmax(ij)
81 enddo
82
83 c calcul de la pente avec limitation
84
85 do ij=iip2+1,ip1jm
86 if( dxqu(ij-1)*dxqu(ij).gt.0.
87 & .and. dxq(ij,l)*dxqu(ij).gt.0.) then
88 dxq(ij,l)=
89 & sign(min(abs(dxq(ij,l)),dxqmax(ij)),dxq(ij,l))
90 else
91 c extremum local
92 dxq(ij,l)=0.
93 endif
94 enddo
95 do ij=iip1+iip1,ip1jm,iip1
96 dxq(ij-iim,l)=dxq(ij,l)
97 enddo
98
99 DO ij=1,ip1jmp1
100 sx(ij,l) = dxq(ij,l)*sm(ij,l)
101 ENDDO
102
103 ENDDO
104
105 RETURN
106 END
107