GCC Code Coverage Report

Directory: ./
File: dyn/dissip.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 36 39 92.3%
Branches: 29 32 90.6%
Line Branch Exec Source
1 !
2 ! $Id: dissip.F 2597 2016-07-22 06:44:47Z emillour $
3 !
4 480 SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
5 c
6 USE comconst_mod, ONLY: dtdiss
7
8 IMPLICIT NONE
9
10
11 c .. Avec nouveaux operateurs star : gradiv2 , divgrad2, nxgraro2 ...
12 c ( 10/01/98 )
13
14 c=======================================================================
15 c
16 c Auteur: P. Le Van
17 c -------
18 c
19 c Objet:
20 c ------
21 c
22 c Dissipation horizontale
23 c
24 c=======================================================================
25 c-----------------------------------------------------------------------
26 c Declarations:
27 c -------------
28
29 include "dimensions.h"
30 include "paramet.h"
31 include "comgeom.h"
32 include "comdissnew.h"
33 include "comdissipn.h"
34
35 c Arguments:
36 c ----------
37
38 REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
39 REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
40 REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
41 REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure
42 ! tendencies (.../s) on covariant winds and potential temperature
43 REAL,INTENT(OUT) :: dv(ip1jm,llm)
44 REAL,INTENT(OUT) :: du(ip1jmp1,llm)
45 REAL,INTENT(OUT) :: dh(ip1jmp1,llm)
46
47 c Local:
48 c ------
49
50 REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
51 REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
52 REAL te1dt(llm),te2dt(llm),te3dt(llm)
53 REAL deltapres(ip1jmp1,llm)
54
55 INTEGER l,ij
56
57 REAL SSUM
58
59 c-----------------------------------------------------------------------
60 c initialisations:
61 c ----------------
62
63
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
64 18720 te1dt(l) = tetaudiv(l) * dtdiss
65 18720 te2dt(l) = tetaurot(l) * dtdiss
66 19200 te3dt(l) = tetah(l) * dtdiss
67 ENDDO
68 480 du=0.
69 480 dv=0.
70 480 dh=0.
71
72 c-----------------------------------------------------------------------
73 c Calcul de la dissipation:
74 c -------------------------
75
76 c Calcul de la partie grad ( div ) :
77 c -------------------------------------
78
79
80
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
 480 IF(lstardis) THEN
81 480 CALL gradiv2( llm,ucov,vcov,nitergdiv,gdx,gdy )
82 ELSE
83 ✗ CALL gradiv ( llm,ucov,vcov,nitergdiv,gdx,gdy )
84 ENDIF
85
86
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
87
88
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 617760 times.
 636480 DO ij = 1, iip1
89 617760 gdx( ij ,l) = 0.
90 636480 gdx(ij+ip1jm,l) = 0.
91 ENDDO
92
93
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 19150560 times.
 19169280 DO ij = iip2,ip1jm
94 19169280 du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
95 ENDDO
96
2/2
✓ Branch 0 taken 19768320 times.
✓ Branch 1 taken 18720 times.
 19787520 DO ij = 1,ip1jm
97 19787040 dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
98 ENDDO
99
100 ENDDO
101
102 c calcul de la partie n X grad ( rot ):
103 c ---------------------------------------
104
105
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
 480 IF(lstardis) THEN
106 480 CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
107 ELSE
108 ✗ CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
109 ENDIF
110
111
112
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
113
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 617760 times.
 636480 DO ij = 1, iip1
114 636480 grx(ij,l) = 0.
115 ENDDO
116
117
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 19150560 times.
 19169280 DO ij = iip2,ip1jm
118 19169280 du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
119 ENDDO
120
2/2
✓ Branch 0 taken 19768320 times.
✓ Branch 1 taken 18720 times.
 19787520 DO ij = 1, ip1jm
121 19787040 dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
122 ENDDO
123 ENDDO
124
125 c calcul de la partie div ( grad ):
126 c -----------------------------------
127
128
129
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
 480 IF(lstardis) THEN
130
131
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l = 1, llm
132
2/2
✓ Branch 0 taken 20386080 times.
✓ Branch 1 taken 18720 times.
 20405280 DO ij = 1, ip1jmp1
133 20404800 deltapres(ij,l) = AMAX1( 0., p(ij,l) - p(ij,l+1) )
134 ENDDO
135 ENDDO
136
137 480 CALL divgrad2( llm,teta, deltapres ,niterh, gdx )
138 ELSE
139 ✗ CALL divgrad ( llm,teta, niterh, gdx )
140 ENDIF
141
142
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l = 1,llm
143
2/2
✓ Branch 0 taken 20386080 times.
✓ Branch 1 taken 18720 times.
 20405280 DO ij = 1,ip1jmp1
144 20404800 dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
145 ENDDO
146 ENDDO
147
148 480 RETURN
149 END
150