GCC Code Coverage Report

Directory: ./
File: dyn/advect.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 56 56 100.0%
Branches: 38 38 100.0%
Line Branch Exec Source
1 !
2 ! $Header$
3 !
4 2881 SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
5
6 USE comconst_mod, ONLY: daysec
7 USE logic_mod, ONLY: conser
8 USE ener_mod, ONLY: gtot
9
10 IMPLICIT NONE
11 c=======================================================================
12 c
13 c Auteurs: P. Le Van , Fr. Hourdin .
14 c -------
15 c
16 c Objet:
17 c ------
18 c
19 c *************************************************************
20 c .... calcul des termes d'advection vertic.pour u,v,teta,q ...
21 c *************************************************************
22 c ces termes sont ajoutes a du,dv,dteta et dq .
23 c Modif F.Forget 03/94 : on retire q de advect
24 c
25 c=======================================================================
26 c-----------------------------------------------------------------------
27 c Declarations:
28 c -------------
29
30 include "dimensions.h"
31 include "paramet.h"
32 include "comgeom.h"
33
34 c Arguments:
35 c ----------
36
37 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
38 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
39 REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
40
41 c Local:
42 c ------
43
44 REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
45 REAL unsaire2(ip1jmp1), ge(ip1jmp1)
46 REAL deuxjour, ww, gt, uu, vv
47
48 INTEGER ij,l
49
50 REAL SSUM
51
52 c-----------------------------------------------------------------------
53 c 2. Calculs preliminaires:
54 c -------------------------
55
56
2/2
✓ Branch 0 taken 81 times.
✓ Branch 1 taken 2800 times.
 2881 IF (conser) THEN
57 81 deuxjour = 2. * daysec
58
59
2/2
✓ Branch 0 taken 88209 times.
✓ Branch 1 taken 81 times.
 88290 DO 1 ij = 1, ip1jmp1
60 88209 unsaire2(ij) = unsaire(ij) * unsaire(ij)
61 81 1 CONTINUE
62 END IF
63
64
65 c------------------ -yy ----------------------------------------------
66 c . Calcul de u
67
68
2/2
✓ Branch 0 taken 112359 times.
✓ Branch 1 taken 2881 times.
 115240 DO l=1,llm
69
2/2
✓ Branch 0 taken 118651104 times.
✓ Branch 1 taken 112359 times.
 118763463 DO ij = iip2, ip1jmp1
70 118763463 uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
71 ENDDO
72
2/2
✓ Branch 0 taken 114943257 times.
✓ Branch 1 taken 112359 times.
 115055616 DO ij = iip2, ip1jm
73 115055616 uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
74 ENDDO
75
2/2
✓ Branch 0 taken 3707847 times.
✓ Branch 1 taken 112359 times.
 3823087 DO ij = 1, iip1
76 3707847 uav(ij ,l) = 0.
77 3820206 uav(ip1jm+ij,l) = 0.
78 ENDDO
79 ENDDO
80
81 c------------------ -xx ----------------------------------------------
82 c . Calcul de v
83
84
2/2
✓ Branch 0 taken 2881 times.
✓ Branch 1 taken 112359 times.
 115240 DO l=1,llm
85
2/2
✓ Branch 0 taken 118538745 times.
✓ Branch 1 taken 112359 times.
 118651104 DO ij = 2, ip1jm
86 118651104 vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
87 ENDDO
88 3595488 DO ij = 1,ip1jm,iip1
89
2/2
✓ Branch 0 taken 3483129 times.
✓ Branch 1 taken 112359 times.
 3595488 vav(ij,l) = vav(ij+iim,l)
90 ENDDO
91
2/2
✓ Branch 0 taken 118538745 times.
✓ Branch 1 taken 112359 times.
 118651104 DO ij = 1, ip1jm-1
92 118651104 vav(ij,l) = vav(ij,l) + vav(ij+1,l)
93 ENDDO
94 2881 DO ij = 1, ip1jm, iip1
95
2/2
✓ Branch 0 taken 3483129 times.
✓ Branch 1 taken 112359 times.
 3595488 vav(ij+iim,l) = vav(ij,l)
96 ENDDO
97 ENDDO
98
99 c-----------------------------------------------------------------------
100
101 c
102
2/2
✓ Branch 0 taken 109478 times.
✓ Branch 1 taken 2881 times.
 112359 DO 20 l = 1, llmm1
103
104
105 c ...... calcul de - w/2. au niveau l+1 .......
106
107
2/2
✓ Branch 0 taken 119221542 times.
✓ Branch 1 taken 109478 times.
 119331020 DO 5 ij = 1, ip1jmp1
108 119221542 wsur2( ij ) = - 0.5 * w( ij,l+1 )
109 109478 5 CONTINUE
110
111
112 c ..................... calcul pour du ..................
113
114
2/2
✓ Branch 0 taken 111886516 times.
✓ Branch 1 taken 109478 times.
 111995994 DO 6 ij = iip2 ,ip1jm-1
115 111886516 ww = wsur2 ( ij ) + wsur2( ij+1 )
116 111886516 uu = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
117 111886516 du(ij,l) = du(ij,l) - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
118 111886516 du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
119 109478 6 CONTINUE
120
121 c ..... correction pour du(iip1,j,l) ........
122 c ..... du(iip1,j,l)= du(1,j,l) .....
123
124 CDIR$ IVDEP
125 3393818 DO 7 ij = iip1 +iip1, ip1jm, iip1
126 3393818 du( ij, l ) = du( ij -iim, l )
127
2/2
✓ Branch 0 taken 3284340 times.
✓ Branch 1 taken 109478 times.
 3393818 du( ij,l+1 ) = du( ij -iim,l+1 )
128 109478 7 CONTINUE
129
130 c ................. calcul pour dv .....................
131
132
2/2
✓ Branch 0 taken 115608768 times.
✓ Branch 1 taken 109478 times.
 115718246 DO 8 ij = 1, ip1jm
133 115608768 ww = wsur2( ij+iip1 ) + wsur2( ij )
134 115608768 vv = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
135 115608768 dv(ij,l) = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
136 115608768 dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
137 109478 8 CONTINUE
138
139 c
140
141 c ............................................................
142 c ............... calcul pour dh ...................
143 c ............................................................
144
145 c ---z
146 c calcul de - d( teta * w ) qu'on ajoute a dh
147 c ...............
148
149
2/2
✓ Branch 0 taken 119221542 times.
✓ Branch 1 taken 109478 times.
 119331020 DO 15 ij = 1, ip1jmp1
150 119221542 ww = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
151 119221542 dteta(ij, l ) = dteta(ij, l ) - ww
152 119221542 dteta(ij,l+1) = dteta(ij,l+1) + ww
153 109478 15 CONTINUE
154
155
2/2
✓ Branch 0 taken 106400 times.
✓ Branch 1 taken 3078 times.
 109478 IF( conser) THEN
156
2/2
✓ Branch 0 taken 3351942 times.
✓ Branch 1 taken 3078 times.
 3355020 DO 17 ij = 1,ip1jmp1
157 3351942 ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij)
158 3078 17 CONTINUE
159 3078 gt = SSUM( ip1jmp1,ge,1 )
160 3078 gtot(l) = deuxjour * SQRT( gt/ip1jmp1 )
161 END IF
162
163 2881 20 CONTINUE
164
165 2881 RETURN
166 END
167